1;; idlwave.el --- IDL editing mode for GNU Emacs 2 3;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 4;; Free Software Foundation, Inc. 5 6;; Authors: J.D. Smith <jdsmith@as.arizona.edu> 7;; Carsten Dominik <dominik@science.uva.nl> 8;; Chris Chase <chase@att.com> 9;; Maintainer: J.D. Smith <jdsmith@as.arizona.edu> 10;; Version: 6.1_em22 11;; Keywords: languages 12 13;; This file is part of GNU Emacs. 14 15;; GNU Emacs is free software; you can redistribute it and/or modify 16;; it under the terms of the GNU General Public License as published by 17;; the Free Software Foundation; either version 2, or (at your option) 18;; any later version. 19 20;; GNU Emacs is distributed in the hope that it will be useful, 21;; but WITHOUT ANY WARRANTY; without even the implied warranty of 22;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 23;; GNU General Public License for more details. 24 25;; You should have received a copy of the GNU General Public License 26;; along with GNU Emacs; see the file COPYING. If not, write to the 27;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 28;; Boston, MA 02110-1301, USA. 29 30;;; Commentary: 31 32;; IDLWAVE enables feature-rich development and interaction with IDL, 33;; the Interactive Data Language. It provides a compelling, 34;; full-featured alternative to the IDLDE development environment 35;; bundled with IDL. 36 37;; In the remotely distant past, based on pascal.el, though bears 38;; little resemblance to it now. 39;; 40;; Incorporates many ideas, such as abbrevs, action routines, and 41;; continuation line indenting, from wave.el. 42;; wave.el original written by Lubos Pochman, Precision Visuals, Boulder. 43;; 44;; See the mode description ("C-h m" in idlwave-mode or "C-h f idlwave-mode") 45;; for features, key bindings, and info. 46;; Also, Info format documentation is available with `M-x idlwave-info' 47;; 48;; New versions of IDLWAVE, documentation, and more information 49;; available from: 50;; http://idlwave.org 51;; 52;; INSTALLATION 53;; ============ 54;; 55;; Follow the instructions in the INSTALL file of the distribution. 56;; In short, put this file on your load path and add the following 57;; lines to your .emacs file: 58;; 59;; (autoload 'idlwave-mode "idlwave" "IDLWAVE Mode" t) 60;; (autoload 'idlwave-shell "idlw-shell" "IDLWAVE Shell" t) 61;; (setq auto-mode-alist (cons '("\\.pro\\'" . idlwave-mode) auto-mode-alist)) 62;; 63;; 64;; SOURCE 65;; ====== 66;; 67;; The newest version of this file is available from the maintainer's 68;; Webpage: 69;; 70;; http://idlwave.org 71;; 72;; DOCUMENTATION 73;; ============= 74;; 75;; IDLWAVE is documented online in info format. A printable version 76;; of the documentation is available from the maintainers webpage (see 77;; SOURCE). 78;; 79;; 80;; ACKNOWLEDGMENTS 81;; =============== 82;; 83;; Thanks to the following people for their contributions and comments: 84;; 85;; Ulrik Dickow <dickow_at_nbi.dk> 86;; Eric E. Dors <edors_at_lanl.gov> 87;; Stein Vidar H. Haugan <s.v.h.haugan_at_astro.uio.no> 88;; David Huenemoerder <dph_at_space.mit.edu> 89;; Kevin Ivory <Kevin.Ivory_at_linmpi.mpg.de> 90;; Dick Jackson <dick_at_d-jackson.com> 91;; Xuyong Liu <liu_at_stsci.edu> 92;; Simon Marshall <Simon.Marshall_at_esrin.esa.it> 93;; Laurent Mugnier <mugnier_at_onera.fr> 94;; Lubos Pochman <lubos_at_rsinc.com> 95;; Bob Portmann <portmann_at_al.noaa.gov> 96;; Patrick M. Ryan <pat_at_jaameri.gsfc.nasa.gov> 97;; Marty Ryba <ryba_at_ll.mit.edu> 98;; Paul Sorenson <aardvark62_at_msn.com> 99;; Phil Sterne <sterne_at_dublin.llnl.gov> 100;; Phil Williams <williams_at_irc.chmcc.org> 101;; 102;; CUSTOMIZATION: 103;; ============= 104;; 105;; IDLWAVE has extensive customize support; to learn about the 106;; variables which control the mode's behavior, use `M-x 107;; idlwave-customize'. 108;; 109;; You can set your own preferred values with Customize, or with Lisp 110;; code in .emacs. For an example of what to put into .emacs, check 111;; the TexInfo documentation or see a complete .emacs available at the 112;; website. 113;; 114;; KNOWN PROBLEMS: 115;; ============== 116;; 117;; IDLWAVE support for the IDL-derived PV-WAVE CL language of Visual 118;; Numerics, Inc. is growing less and less complete as the two 119;; languages grow increasingly apart. The mode probably shouldn't 120;; even have "WAVE" in its title, but it's catchy, and was required 121;; to avoid conflict with the CORBA idl.el mode. Caveat WAVEor. 122;; 123;; Moving the point backwards in conjunction with abbrev expansion 124;; does not work as I would like it, but this is a problem with 125;; emacs abbrev expansion done by the self-insert-command. It ends 126;; up inserting the character that expanded the abbrev after moving 127;; point backward, e.g., "\cl" expanded with a space becomes 128;; "LONG( )" with point before the close paren. This is solved by 129;; using a temporary function in `post-command-hook' - not pretty, 130;; but it works. 131;; 132;; Tabs and spaces are treated equally as whitespace when filling a 133;; comment paragraph. To accomplish this, tabs are permanently 134;; replaced by spaces in the text surrounding the paragraph, which 135;; may be an undesirable side-effect. Replacing tabs with spaces is 136;; limited to comments only and occurs only when a comment 137;; paragraph is filled via `idlwave-fill-paragraph'. 138;; 139;; Muti-statement lines (using "&") on block begin and end lines can 140;; ruin the formatting. For example, multiple end statements on a 141;; line: endif & endif. Using "&" outside of block begin/end lines 142;; should be okay. 143;; 144;; Determining the expression at point for printing and other 145;; examination commands is somewhat rough: currently only fairly 146;; simple entities are found. You can always drag-select or examine 147;; a pre-selected region. 148;; 149;; When forcing completion of method keywords, the initial 150;; query for a method has multiple entries for some methods. Would 151;; be too difficult to fix this hardly used case. 152;; 153 154;;; Code: 155 156 157(eval-when-compile (require 'cl)) 158(require 'idlw-help) 159 160;; For XEmacs 161(unless (fboundp 'line-beginning-position) 162 (defalias 'line-beginning-position 'point-at-bol)) 163(unless (fboundp 'line-end-position) 164 (defalias 'line-end-position 'point-at-eol)) 165(unless (fboundp 'char-valid-p) 166 (defalias 'char-valid-p 'characterp)) 167(unless (fboundp 'match-string-no-properties) 168 (defalias 'match-string-no-properties 'match-string)) 169 170(if (not (fboundp 'cancel-timer)) 171 (condition-case nil 172 (require 'timer) 173 (error nil))) 174 175(eval-and-compile 176 ;; Kludge to allow `defcustom' for Emacs 19. 177 (condition-case () (require 'custom) (error nil)) 178 (if (and (featurep 'custom) (fboundp 'custom-declare-variable)) 179 nil ;; We've got what we needed 180 ;; We have the old or no custom-library, hack around it! 181 (defmacro defgroup (&rest args) nil) 182 (defmacro defcustom (var value doc &rest args) 183 `(defvar ,var ,value ,doc)))) 184 185(defgroup idlwave nil 186 "Major mode for editing IDL .pro files." 187 :tag "IDLWAVE" 188 :link '(url-link :tag "Home Page" 189 "http://idlwave.org") 190 :link '(emacs-commentary-link :tag "Commentary in idlw-shell.el" 191 "idlw-shell.el") 192 :link '(emacs-commentary-link :tag "Commentary in idlwave.el" "idlwave.el") 193 :link '(custom-manual "(idlwave)Top") 194 :prefix "idlwave" 195 :group 'languages) 196 197 198;;; Variables for indentation behavior --------------------------------------- 199 200(defgroup idlwave-code-formatting nil 201 "Indentation and formatting options for IDLWAVE mode." 202 :group 'idlwave) 203 204(defcustom idlwave-main-block-indent 2 205 "*Extra indentation for the main block of code. 206That is the block between the FUNCTION/PRO statement and the END 207statement for that program unit." 208 :group 'idlwave-code-formatting 209 :type 'integer) 210 211(defcustom idlwave-block-indent 3 212 "*Extra indentation applied to block lines. 213If you change this, you probably also want to change `idlwave-end-offset'." 214 :group 'idlwave-code-formatting 215 :type 'integer) 216 217(defcustom idlwave-end-offset -3 218 "*Extra indentation applied to block END lines. 219A value equal to negative `idlwave-block-indent' will make END lines 220line up with the block BEGIN lines." 221 :group 'idlwave-code-formatting 222 :type 'integer) 223 224(defcustom idlwave-continuation-indent 3 225 "*Extra indentation applied to continuation lines. 226This extra offset applies to the first of a set of continuation lines. 227The following lines receive the same indentation as the first." 228 :group 'idlwave-code-formatting 229 :type 'integer) 230 231(defcustom idlwave-max-extra-continuation-indent 40 232 "*Maximum additional indentation for special continuation indent. 233Several special indentations are tried to help line up continuation 234lines in routine calls or definitions, other statements with 235parentheses, or assignment statements. This variable specifies a 236maximum amount by which this special indentation can exceed the 237standard continuation indentation, otherwise defaulting to a fixed 238offset. Set to 0 to effectively disable all special continuation 239indentation, or to a large number (like 100) to enable it in all 240cases. See also `idlwave-indent-to-open-paren', which can override 241this variable." 242 :group 'idlwave-code-formatting 243 :type 'integer) 244 245(defcustom idlwave-indent-to-open-paren t 246 "*Non-nil means, indent continuation lines to innermost open 247parenthesis. This indentation occurs even if otherwise disallowed by 248`idlwave-max-extra-continuation-indent'. Matching parens and the 249interleaving args are lined up. Example: 250 251 x = function_a(function_b(function_c( a, b, [1,2,3, $ 252 4,5,6 $ 253 ], $ 254 c, d $ 255 ))) 256 257When this variable is nil, paren alignment may still occur, based on 258the value of `max-extra-continuation-indent', which, if zero, would 259yield: 260 261 x = function_a(function_b(function_c( a, b, [1,2,3, $ 262 4,5,6 $ 263 ], $ 264 c, d $ 265 )))" 266 :group 'idlwave-code-formatting 267 :type 'boolean) 268 269(defcustom idlwave-indent-parens-nested nil 270 "*Non-nil means, indent continuation lines with parens by nesting 271lines at consecutively deeper levels." 272 :group 'idlwave-code-formatting 273 :type 'boolean) 274 275 276(defcustom idlwave-hanging-indent t 277 "*If set non-nil then comment paragraphs are indented under the 278hanging indent given by `idlwave-hang-indent-regexp' match in the first line 279of the paragraph." 280 :group 'idlwave-code-formatting 281 :type 'boolean) 282 283(defcustom idlwave-hang-indent-regexp "- " 284 "*Regular expression matching the position of the hanging indent 285in the first line of a comment paragraph. The size of the indent 286extends to the end of the match for the regular expression." 287 :group 'idlwave-code-formatting 288 :type 'regexp) 289 290(defcustom idlwave-use-last-hang-indent nil 291 "*If non-nil then use last match on line for `idlwave-indent-regexp'." 292 :group 'idlwave-code-formatting 293 :type 'boolean) 294 295(defcustom idlwave-fill-comment-line-only t 296 "*If non-nil then auto fill will only operate on comment lines." 297 :group 'idlwave-code-formatting 298 :type 'boolean) 299 300(defcustom idlwave-auto-fill-split-string t 301 "*If non-nil then auto fill will split strings with the IDL `+' operator. 302When the line end falls within a string, string concatenation with the 303'+' operator will be used to distribute a long string over lines. 304If nil and a string is split then a terminal beep and warning are issued. 305 306This variable is ignored when `idlwave-fill-comment-line-only' is 307non-nil, since in this case code is not auto-filled." 308 :group 'idlwave-code-formatting 309 :type 'boolean) 310 311(defcustom idlwave-split-line-string t 312 "*If non-nil then `idlwave-split-line' will split strings with `+'. 313When the splitting point of a line falls inside a string, split the string 314using the `+' string concatenation operator. If nil and a string is 315split then a terminal beep and warning are issued." 316 :group 'idlwave-code-formatting 317 :type 'boolean) 318 319(defcustom idlwave-no-change-comment ";;;" 320 "*The indentation of a comment that starts with this regular 321expression will not be changed. Note that the indentation of a comment 322at the beginning of a line is never changed." 323 :group 'idlwave-code-formatting 324 :type 'string) 325 326(defcustom idlwave-begin-line-comment nil 327 "*A comment anchored at the beginning of line. 328A comment matching this regular expression will not have its 329indentation changed. If nil the default is \"^;\", i.e., any line 330beginning with a \";\". Expressions for comments at the beginning of 331the line should begin with \"^\"." 332 :group 'idlwave-code-formatting 333 :type '(choice (const :tag "Any line beginning with `;'" nil) 334 'regexp)) 335 336(defcustom idlwave-code-comment ";;[^;]" 337 "*A comment that starts with this regular expression on a line by 338itself is indented as if it is a part of IDL code. As a result if 339the comment is not preceded by whitespace it is unchanged." 340 :group 'idlwave-code-formatting 341 :type 'regexp) 342 343;; Comments not matching any of the above will be indented as a 344;; right-margin comment, i.e., to a minimum of `comment-column'. 345 346;;; Routine Info and Completion --------------------------------------- 347 348(defgroup idlwave-routine-info nil 349 "Routine Info options for IDLWAVE mode." 350 :group 'idlwave) 351 352(defcustom idlwave-use-library-catalogs t 353 "*Non-nil means search the IDL path for library catalog files. 354 355These files, named .idlwave_catalog, document routine information for 356individual directories and libraries of IDL .pro files. Many popular 357libraries come with catalog files by default, so leaving this on is a 358usually a good idea.." 359 :group 'idlwave-routine-info 360 :type 'boolean) 361 362(defcustom idlwave-init-rinfo-when-idle-after 10 363 "*Seconds of idle time before routine info is automatically 364initialized. Initializing the routine info can take a long time, in 365particular if a large number of library catalogs are involved. When 366Emacs is idle for more than the number of seconds specified by this 367variable, it starts the initialization. The process is split into 368five steps, in order to keep work interruption as short as possible. 369If one of the steps finishes, and no user input has arrived in the 370mean time, initialization proceeds immediately to the next step. A 371good value for this variable is about 1/3 of the time initialization 372take in your setup. So if you have a fast machine and no problems 373with a slow network connection, don't hesitate to set this to 2 374seconds. A Value of 0 means, don't initialize automatically, but 375instead wait until routine information is needed, and initialize 376then." 377 :group 'idlwave-routine-info 378 :type 'number) 379 380(defcustom idlwave-scan-all-buffers-for-routine-info t 381 "*Non-nil means, scan buffers for IDL programs when updating info. 382The scanning is done by the command `idlwave-update-routine-info'. 383The following values are allowed: 384 385nil Don't scan any buffers. 386t Scan all idlwave-mode buffers in the current editing session. 387current Scan only the current buffer, but no other buffers." 388 :group 'idlwave-routine-info 389 :type '(choice 390 (const :tag "No buffer" nil) 391 (const :tag "All buffers" t) 392 (const :tag "Current buffer only" 'current))) 393 394(defcustom idlwave-query-shell-for-routine-info t 395 "*Non-nil means query the shell for info about compiled routines. 396Querying the shell is useful to get information about compiled modules, 397and it is turned on by default. However, when you have a complete library 398scan, this is not necessary." 399 :group 'idlwave-routine-info 400 :type 'boolean) 401 402(defcustom idlwave-auto-routine-info-updates 403 '(find-file save-buffer kill-buffer compile-buffer) 404 "*Controls under what circumstances routine info is updated automatically. 405Possible values: 406nil Never 407t All available 408\(...) A list of circumstances. Allowed members are: 409 find-file Add info for new IDLWAVE buffers. 410 save-buffer Update buffer info when buffer is saved 411 kill-buffer Remove buffer info when buffer gets killed 412 compile-buffer Update shell info after `idlwave-shell-save-and...'" 413 :group 'idlwave-routine-info 414 :type '(choice 415 (const :tag "Never" nil) 416 (const :tag "As often as possible" t) 417 (set :tag "Checklist" :greedy t 418 (const :tag "When visiting a file" find-file) 419 (const :tag "When saving a buffer" save-buffer) 420 (const :tag "After a buffer was killed" kill-buffer) 421 (const :tag "After a buffer was compiled successfully, update shell info" compile-buffer)))) 422 423(defcustom idlwave-rinfo-max-source-lines 5 424 "*Maximum number of source files displayed in the Routine Info window. 425When an integer, it is the maximum number of source files displayed. 426t means to show all source files." 427 :group 'idlwave-routine-info 428 :type 'integer) 429 430(defcustom idlwave-library-path nil 431 "Library path for Windows and MacOS (OS9). Not needed under UNIX. 432When selecting the directories to scan for IDL user catalog routine 433info, IDLWAVE can, under UNIX, query the shell for the exact search 434path \(the value of !PATH). However, under Windows and MacOS 435\(pre-OSX), the IDLWAVE shell does not work. In this case, this 436variable can be set to specify the paths where IDLWAVE can find PRO 437files. The shell will only be asked for a list of paths when this 438variable is nil. The value is a list of directories. A directory 439preceeded by a `+' will be searched recursively. If you set this 440variable on a UNIX system, the shell will not be queried. See also 441`idlwave-system-directory'." 442 :group 'idlwave-routine-info 443 :type '(repeat (directory))) 444 445(defcustom idlwave-system-directory "" 446 "The IDL system directory for Windows and MacOS. Not needed under 447UNIX. Set this to the value of the `!DIR' system variable in IDL. 448IDLWAVE uses this to find out which of the library routines belong to 449the official system library. All files inside the `lib' subdirectory 450are considered system library files - so don't install private stuff 451in this directory. On UNIX systems, IDLWAVE queries the shell for the 452value of `!DIR'. See also `idlwave-library-path'." 453 :group 'idlwave-routine-info 454 :type 'directory) 455 456;; Configuration files 457(defcustom idlwave-config-directory 458 (convert-standard-filename "~/.idlwave") 459 "*Directory for configuration files and user-library catalog." 460 :group 'idlwave-routine-info 461 :type 'file) 462 463(defvar idlwave-user-catalog-file "idlusercat.el") 464(defvar idlwave-xml-system-rinfo-converted-file "idl_xml_rinfo.el") 465(defvar idlwave-path-file "idlpath.el") 466 467(defvar idlwave-libinfo-file nil 468 "*Obsolete variable, no longer used.") 469 470(defcustom idlwave-special-lib-alist nil 471 "Alist of regular expressions matching special library directories. 472When listing routine source locations, IDLWAVE gives a short hint where 473the file defining the routine is located. By default it lists `SystemLib' 474for routines in the system library `!DIR/lib' and `Library' for anything 475else. This variable can define additional types. The car of each entry 476is a regular expression matching the file name (they normally will match 477on the path). The cdr is the string to be used as identifier. Max 10 478chars are allowed." 479 :group 'idlwave-routine-info 480 :type '(repeat 481 (cons regexp string))) 482 483(defcustom idlwave-auto-write-paths t 484 "Write out path (!PATH) and system directory (!DIR) info automatically. 485Path info is needed to locate library catalog files. If non-nil, 486whenever the path-list changes as a result of shell-query, etc., it is 487written to file. Otherwise, the menu option \"Write Paths\" can be 488used to force a write." 489 :group 'idlwave-routine-info 490 :type 'boolean) 491 492(defgroup idlwave-completion nil 493 "Completion options for IDLWAVE mode." 494 :prefix "idlwave" 495 :group 'idlwave) 496 497(eval-and-compile 498 (defconst idlwave-tmp 499 '(choice :tag "by applying the function" 500 (const upcase) 501 (const downcase) 502 (const capitalize) 503 (const preserve) 504 (symbol :tag "Other")))) 505 506(defcustom idlwave-completion-case '((routine . upcase) 507 (keyword . upcase) 508 (class . preserve) 509 (method . preserve)) 510 "Association list setting the case of completed words. 511 512This variable determines the case (UPPER/lower/Capitalized...) of 513words inserted into the buffer by completion. The preferred case can 514be specified separately for routine names, keywords, classes and 515methods. 516This alist should therefore have entries for `routine' (normal 517functions and procedures, i.e. non-methods), `keyword', `class', and 518`method'. Plausible values are 519 520upcase upcase whole word, like `BOX_CURSOR' 521downcase downcase whole word, like `read_ppm' 522capitalize capitalize each part, like `Widget_Control' 523preserve preserve case as is, like `IDLgrView' 524 525The value can also be any Emacs Lisp function which transforms the 526case of characters in a string. 527 528A value of `preserve' means that the case of the completed word is 529identical to the way it was written in the definition statement of the 530routine. This was implemented to allow for mixed-case completion, in 531particular of object classes and methods. 532If a completable word is defined in multiple locations, the meaning of 533`preserve' is not unique since the different definitions might be 534cased differently. Therefore IDLWAVE always takes the case of the 535*first* definition it encounters during routine info collection and 536uses the case derived from it consistently. 537 538Note that a lowercase-only string in the buffer will always be completed in 539lower case (but see the variable `idlwave-completion-force-default-case'). 540 541After changing this variable, you need to either restart Emacs or press 542`C-u C-c C-i' to update the internal lists." 543 :group 'idlwave-completion 544 :type `(repeat 545 (cons (symbol :tag "Derive completion case for") 546 ,idlwave-tmp))) 547 548(defcustom idlwave-completion-force-default-case nil 549 "*Non-nil means, completion will always honor `idlwave-completion-case'. 550When nil, only the completion of a mixed case or upper case string 551will honor the default settings in `idlwave-completion-case', while 552the completion of lower case strings will be completed entirely in 553lower case." 554 :group 'idlwave-completion 555 :type 'boolean) 556 557(defcustom idlwave-complete-empty-string-as-lower-case nil 558 "*Non-nil means, the empty string is considered downcase for completion. 559The case of what is already in the buffer determines the case of completions. 560When this variable is non-nil, the empty string is considered to be downcase. 561Completing on the empty string then offers downcase versions of the possible 562completions." 563 :group 'idlwave-completion 564 :type 'boolean) 565 566(defvar idlwave-default-completion-case-is-down nil 567 "Obsolete variable. See `idlwave-complete-empty-string-as-lower-case' and 568`idlwave-completion-case'.") 569 570(defcustom idlwave-buffer-case-takes-precedence nil 571 "*Non-nil means, the case of tokens in buffers dominates over system stuff. 572To make this possible, we need to re-case everything each time we update 573the routine info from the buffers. This is slow. 574The default is to consider the case given in the system and library files 575first which makes updating much faster." 576 :group 'idlwave-completion 577 :type 'boolean) 578 579(defcustom idlwave-highlight-help-links-in-completion t 580 "*Non-nil means, highlight completions for which system help is available. 581Help can then be accessed with mouse-3. 582This option is only effective when the online help system is installed." 583 :group 'idlwave-completion 584 :type 'boolean) 585 586(defcustom idlwave-support-inheritance t 587 "Non-nil means, treat inheritance with completion, online help etc. 588When nil, IDLWAVE only knows about the native methods and tags of a class, 589not about inherited ones." 590 :group 'idlwave-routine-info 591 :type 'boolean) 592 593(defcustom idlwave-keyword-class-inheritance '("^[gs]etproperty$" "^init$") 594 "List of regular expressions for class-driven keyword inheritance. 595Keyword inheritance is often tied to class inheritance by \"chaining\" 596up the class tree. While it cannot be assumed that the presence of an 597_EXTRA or _REF_EXTRA symbol guarantees such chaining will occur, for 598certain methods this assumption is almost always true. The methods 599for which to assume this can be set here." 600 :group 'idlwave-routine-info 601 :type '(repeat (regexp :tag "Match method:"))) 602 603 604(defcustom idlwave-completion-show-classes 1 605 "*Number of classes to show when completing object methods and keywords. 606When completing methods or keywords for an object with unknown class, 607the *Completions* buffer will show the valid classes for each completion 608like this: 609 610MyMethod <Class1,Class2,Class3> 611 612The value of this variable may be nil to inhibit display, or an integer to 613indicate the maximum number of classes to display. 614 615On XEmacs, a full list of classes will also be placed into a `help-echo' 616property on the competion items, so that the list of classes for the current 617item is displayed in the echo area. If the value of this variable is a 618negative integer, the `help-echo' property will be suppressed." 619 :group 'idlwave-completion 620 :type '(choice (const :tag "Don't show" nil) 621 (integer :tag "Number of classes shown" 1))) 622 623(defcustom idlwave-completion-fontify-classes t 624 "*Non-nil means, fontify the classes in completions buffer. 625This makes it easier to distinguish the completion items from the extra 626class info listed. See `idlwave-completion-show-classes'." 627 :group 'idlwave-completion 628 :type 'boolean) 629 630(defcustom idlwave-query-class '((method-default . nil) 631 (keyword-default . nil)) 632 "Association list governing specification of object classes for completion. 633 634When IDLWAVE tries to complete object-oriented methods, it usually 635cannot determine the class of a given object from context. In order 636to provide the user with a correct list of methods or keywords, it 637needs to determine the appropriate class. IDLWAVE has two ways of 638doing this (well, three ways if you count the shell... see 639`idlwave-shell-query-for-class'): 640 6411. Combine the items of all available classes which contain this 642 method for the purpose of completion. So when completing a method, 643 all methods of all known classes are available, and when completing 644 a keyword, all keywords allowed for this method in any class are 645 shown. This behavior is very much like normal completion and is 646 therefore the default. It works much better than one might think - 647 only for the INIT, GETPROPERTY and SETPROPERTY the keyword lists 648 become uncomfortably long. See also 649 `idlwave-completion-show-classes'. 650 6512. The second possibility is to ask the user on each occasion. To 652 make this less interruptive, IDLWAVE can store the class as a text 653 property on the object operator `->'. For a given object in the 654 source code, class selection will then be needed only once 655 - for example to complete the method. Keywords to the method can 656 then be completed directly, because the class is already known. 657 You will have to turn on the storage of the selected class 658 explicitly with the variable `idlwave-store-inquired-class'. 659 660This variable allows you to configure IDLWAVE's method and 661method-keyword completion behavior. Its value is an alist, which 662should contain at least two elements: (method-default . VALUE) and 663\(keyword-default . VALUE), where VALUE is either t or nil. These 664specify if the class should be found during method and keyword 665completion, respectively. 666 667The alist may have additional entries specifying exceptions from the 668keyword completion rule for specific methods, like INIT or 669GETPROPERTY. In order to turn on class specification for the INIT 670method, add an entry (\"INIT\" . t). The method name must be ALL-CAPS." 671 :group 'idlwave-completion 672 :type '(list 673 (cons (const method-default) 674 (boolean :tag "Determine class when completing METHODS ")) 675 (cons (const keyword-default) 676 (boolean :tag "Determine class when completing KEYWORDS ")) 677 (repeat 678 :tag "Exceptions to defaults" 679 :inline t 680 (cons (string :tag "MODULE" :value "") 681 (boolean :tag "Determine class for this method"))))) 682 683(defcustom idlwave-store-inquired-class t 684 "*Non-nil means, store class of a method call as text property on `->'. 685IDLWAVE sometimes has to ask the user for the class associated with a 686particular object method call. This happens during the commands 687`idlwave-routine-info' and `idlwave-complete', depending upon the 688value of the variable `idlwave-query-class'. 689 690When you specify a class, this information can be stored as a text 691property on the `->' arrow in the source code, so that during the same 692editing session, IDLWAVE will not have to ask again. When this 693variable is non-nil, IDLWAVE will store and reuse the class information. 694The class stored can be checked and removed with `\\[idlwave-routine-info]' 695on the arrow. 696 697The default of this variable is nil, since the result of commands then 698is more predictable. However, if you know what you are doing, it can 699be nice to turn this on. 700 701An arrow which knows the class will be highlighted with 702`idlwave-class-arrow-face'. The command \\[idlwave-routine-info] 703displays (with prefix arg: deletes) the class stored on the arrow 704at point." 705 :group 'idlwave-completion 706 :type 'boolean) 707 708(defcustom idlwave-class-arrow-face 'bold 709 "*Face to highlight object operator arrows `->' which carry a class property. 710When IDLWAVE stores a class name as text property on an object arrow 711\(see variable `idlwave-store-inquired-class', it highlights the arrow 712with this font in order to remind the user that this arrow is special." 713 :group 'idlwave-completion 714 :type 'symbol) 715 716(defcustom idlwave-resize-routine-help-window t 717 "*Non-nil means, resize the Routine-info *Help* window to fit the content." 718 :group 'idlwave-completion 719 :type 'boolean) 720 721(defcustom idlwave-keyword-completion-adds-equal t 722 "*Non-nil means, completion automatically adds `=' after completed keywords." 723 :group 'idlwave-completion 724 :type 'boolean) 725 726(defcustom idlwave-function-completion-adds-paren t 727 "*Non-nil means, completion automatically adds `(' after completed function. 728nil means, don't add anything. 729A value of `2' means, also add the closing parenthesis and position cursor 730between the two." 731 :group 'idlwave-completion 732 :type '(choice (const :tag "Nothing" nil) 733 (const :tag "(" t) 734 (const :tag "()" 2))) 735 736(defcustom idlwave-completion-restore-window-configuration t 737 "*Non-nil means, try to restore the window configuration after completion. 738When completion is not unique, Emacs displays a list of completions. 739This messes up your window configuration. With this variable set, IDLWAVE 740restores the old configuration after successful completion." 741 :group 'idlwave-completion 742 :type 'boolean) 743 744;;; Variables for abbrev and action behavior ----------------------------- 745 746(defgroup idlwave-abbrev-and-indent-action nil 747 "IDLWAVE performs actions when expanding abbreviations or indenting lines. 748The variables in this group govern this." 749 :group 'idlwave) 750 751(defcustom idlwave-do-actions nil 752 "*Non-nil means performs actions when indenting. 753The actions that can be performed are listed in `idlwave-indent-action-table'." 754 :group 'idlwave-abbrev-and-indent-action 755 :type 'boolean) 756 757(defcustom idlwave-abbrev-start-char "\\" 758 "*A single character string used to start abbreviations in abbrev mode. 759Possible characters to chose from: ~`\% 760or even '?'. '.' is not a good choice because it can make structure 761field names act like abbrevs in certain circumstances. 762 763Changes to this in `idlwave-mode-hook' will have no effect. Instead a user 764must set it directly using `setq' in the .emacs file before idlwave.el 765is loaded." 766 :group 'idlwave-abbrev-and-indent-action 767 :type 'string) 768 769(defcustom idlwave-surround-by-blank nil 770 "*Non-nil means, enable `idlwave-surround'. 771If non-nil, `=',`<',`>',`&',`,', `->' are surrounded with spaces by 772`idlwave-surround'. 773See help for `idlwave-indent-action-table' for symbols using `idlwave-surround'. 774 775Also see the default key bindings for keys using `idlwave-surround'. 776Keys are bound and made into actions calling `idlwave-surround' with 777`idlwave-action-and-binding'. 778See help for `idlwave-action-and-binding' for examples. 779 780Also see help for `idlwave-surround'." 781 :group 'idlwave-abbrev-and-indent-action 782 :type 'boolean) 783 784(defcustom idlwave-pad-keyword t 785 "*Non-nil means pad '=' in keywords (routine calls or defs) like assignment. 786Whenever `idlwave-surround' is non-nil then this affects how '=' is 787padded for keywords and for variables. If t, pad the same as for 788assignments. If nil then spaces are removed. With any other value, 789spaces are left unchanged." 790 :group 'idlwave-abbrev-and-indent-action 791 :type '(choice 792 (const :tag "Pad like assignments" t) 793 (const :tag "Remove space near `='" nil) 794 (const :tag "Keep space near `='" 'keep))) 795 796(defcustom idlwave-show-block t 797 "*Non-nil means point blinks to block beginning for `idlwave-show-begin'." 798 :group 'idlwave-abbrev-and-indent-action 799 :type 'boolean) 800 801(defcustom idlwave-expand-generic-end nil 802 "*Non-nil means expand generic END to ENDIF/ENDELSE/ENDWHILE etc." 803 :group 'idlwave-abbrev-and-indent-action 804 :type 'boolean) 805 806(defcustom idlwave-reindent-end t 807 "*Non-nil means re-indent line after END was typed." 808 :group 'idlwave-abbrev-and-indent-action 809 :type 'boolean) 810 811(defcustom idlwave-abbrev-move t 812 "*Non-nil means the abbrev hook can move point. 813Set to nil by `idlwave-expand-region-abbrevs'. To see the abbrev 814definitions, use the command `list-abbrevs', for abbrevs that move 815point. Moving point is useful, for example, to place point between 816parentheses of expanded functions. 817 818See `idlwave-check-abbrev'." 819 :group 'idlwave-abbrev-and-indent-action 820 :type 'boolean) 821 822(defcustom idlwave-abbrev-change-case nil 823 "*Non-nil means all abbrevs will be forced to either upper or lower case. 824If the value t, all expanded abbrevs will be upper case. 825If the value is 'down then abbrevs will be forced to lower case. 826If nil, the case will not change. 827If `idlwave-reserved-word-upcase' is non-nil, reserved words will always be 828upper case, regardless of this variable." 829 :group 'idlwave-abbrev-and-indent-action 830 :type 'boolean) 831 832(defcustom idlwave-reserved-word-upcase nil 833 "*Non-nil means, reserved words will be made upper case via abbrev expansion. 834If nil case of reserved words is controlled by `idlwave-abbrev-change-case'. 835Has effect only if in abbrev-mode." 836 :group 'idlwave-abbrev-and-indent-action 837 :type 'boolean) 838 839;;; Action/Expand Tables. 840;; 841;; The average user may have difficulty modifying this directly. It 842;; can be modified/set in idlwave-mode-hook, but it is easier to use 843;; idlwave-action-and-binding. See help for idlwave-action-and-binding for 844;; examples of how to add an action. 845;; 846;; The action table is used by `idlwave-indent-line' whereas both the 847;; action and expand tables are used by `idlwave-indent-and-action'. In 848;; general, the expand table is only used when a line is explicitly 849;; indented. Whereas, in addition to being used when the expand table 850;; is used, the action table is used when a line is indirectly 851;; indented via line splitting, auto-filling or a new line creation. 852;; 853;; Example actions: 854;; 855;; Capitalize system vars 856;; (idlwave-action-and-binding idlwave-sysvar '(capitalize-word 1) t) 857;; 858;; Capitalize procedure name 859;; (idlwave-action-and-binding "\\<\\(pro\\|function\\)\\>[ \t]*\\<" 860;; '(capitalize-word 1) t) 861;; 862;; Capitalize common block name 863;; (idlwave-action-and-binding "\\<common\\>[ \t]+\\<" 864;; '(capitalize-word 1) t) 865;; Capitalize label 866;; (idlwave-action-and-binding (concat "^[ \t]*" idlwave-label) 867;; '(capitalize-word -1) t) 868 869(defvar idlwave-indent-action-table nil 870 "*Associated array containing action lists of search string (car), 871and function as a cdr. This table is used by `idlwave-indent-line'. 872See documentation for `idlwave-do-action' for a complete description of 873the action lists. 874 875Additions to the table are made with `idlwave-action-and-binding' when a 876binding is not requested. 877See help on `idlwave-action-and-binding' for examples.") 878 879(defvar idlwave-indent-expand-table nil 880 "*Associated array containing action lists of search string (car), 881and function as a cdr. The table is used by the 882`idlwave-indent-and-action' function. See documentation for 883`idlwave-do-action' for a complete description of the action lists. 884 885Additions to the table are made with `idlwave-action-and-binding' when a 886binding is requested. 887See help on `idlwave-action-and-binding' for examples.") 888 889;;; Documentation header and history keyword --------------------------------- 890 891(defgroup idlwave-documentation nil 892 "Options for documenting IDLWAVE files." 893 :group 'idlwave) 894 895;; FIXME: make defcustom? 896(defvar idlwave-file-header 897 (list nil 898 ";+ 899; NAME: 900; 901; 902; 903; PURPOSE: 904; 905; 906; 907; CATEGORY: 908; 909; 910; 911; CALLING SEQUENCE: 912; 913; 914; 915; INPUTS: 916; 917; 918; 919; OPTIONAL INPUTS: 920; 921; 922; 923; KEYWORD PARAMETERS: 924; 925; 926; 927; OUTPUTS: 928; 929; 930; 931; OPTIONAL OUTPUTS: 932; 933; 934; 935; COMMON BLOCKS: 936; 937; 938; 939; SIDE EFFECTS: 940; 941; 942; 943; RESTRICTIONS: 944; 945; 946; 947; PROCEDURE: 948; 949; 950; 951; EXAMPLE: 952; 953; 954; 955; MODIFICATION HISTORY: 956; 957;- 958") 959 "*A list (PATHNAME STRING) specifying the doc-header template to use for 960summarizing a file. If PATHNAME is non-nil then this file will be included. 961Otherwise STRING is used. If nil, the file summary will be omitted. 962For example you might set PATHNAME to the path for the 963lib_template.pro file included in the IDL distribution.") 964 965(defcustom idlwave-header-to-beginning-of-file t 966 "*Non-nil means, the documentation header will always be at start of file. 967When nil, the header is positioned between the PRO/FUNCTION line of 968the current routine and the code, allowing several routine headers in 969a file." 970 :group 'idlwave-documentation 971 :type 'boolean) 972 973(defcustom idlwave-timestamp-hook 'idlwave-default-insert-timestamp 974 "*The hook function used to update the timestamp of a function." 975 :group 'idlwave-documentation 976 :type 'function) 977 978(defcustom idlwave-doc-modifications-keyword "HISTORY" 979 "*The modifications keyword to use with the log documentation commands. 980A ':' is added to the keyword end. 981Inserted by doc-header and used to position logs by doc-modification. 982If nil it will not be inserted." 983 :group 'idlwave-documentation 984 :type 'string) 985 986(defcustom idlwave-doclib-start "^;+\\+" 987 "*Regexp matching the start of a document library header." 988 :group 'idlwave-documentation 989 :type 'regexp) 990 991(defcustom idlwave-doclib-end "^;+-" 992 "*Regexp matching the end of a document library header." 993 :group 'idlwave-documentation 994 :type 'regexp) 995 996;;; External Programs ------------------------------------------------------- 997 998(defgroup idlwave-external-programs nil 999 "Path locations of external commands used by IDLWAVE." 1000 :group 'idlwave) 1001 1002(defcustom idlwave-shell-explicit-file-name "idl" 1003 "*If non-nil, this is the command to run IDL. 1004Should be an absolute file path or path relative to the current environment 1005execution search path. If you want to specify command line switches 1006for the idl program, use `idlwave-shell-command-line-options'. 1007 1008I know the name of this variable is badly chosen, but I cannot change 1009it without compromizing backwards-compatibility." 1010 :group 'idlwave-external-programs 1011 :type 'string) 1012 1013(defcustom idlwave-shell-command-line-options nil 1014 "*A list of command line options for calling the IDL program. 1015Since IDL is executed directly without going through a shell like /bin/sh, 1016this should be a list of strings like '(\"-rt=file\" \"-nw\") with a separate 1017string for each argument. But you may also give a single string which 1018contains the options whitespace-separated. Emacs will be kind enough to 1019split it for you." 1020 :type '(choice 1021 string 1022 (repeat (string :value ""))) 1023 :group 'idlwave-external-programs) 1024 1025(defcustom idlwave-help-application "idlhelp" 1026 "*The external application providing reference help for programming. 1027Obsolete, if the IDL Assistant is being used for help." 1028 :group 'idlwave-external-programs 1029 :type 'string) 1030 1031;;; Some Shell variables which must be defined here.----------------------- 1032 1033(defcustom idlwave-shell-debug-modifiers '() 1034 "List of modifiers to be used for the debugging commands. 1035Will be used to bind debugging commands in the shell buffer and in all 1036source buffers. These are additional convenience bindings, the debugging 1037commands are always available with the `C-c C-d' prefix. 1038If you set this to '(control shift), this means setting a breakpoint will 1039be on `C-S-b', compiling a source file on `C-S-c' etc. Possible modifiers 1040are `control', `meta', `super', `hyper', `alt', and `shift'." 1041 :group 'idlwave-shell-general-setup 1042 :type '(set :tag "Specify modifiers" 1043 (const control) 1044 (const meta) 1045 (const super) 1046 (const hyper) 1047 (const alt) 1048 (const shift))) 1049 1050(defcustom idlwave-shell-automatic-start nil 1051 "*If non-nil attempt invoke idlwave-shell if not already running. 1052This is checked when an attempt to send a command to an 1053IDL process is made." 1054 :group 'idlwave-shell-general-setup 1055 :type 'boolean) 1056 1057;;; Miscellaneous variables ------------------------------------------------- 1058 1059(defgroup idlwave-misc nil 1060 "Miscellaneous options for IDLWAVE mode." 1061 :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces) 1062 :group 'idlwave) 1063 1064(defcustom idlwave-startup-message t 1065 "*Non-nil displays a startup message when `idlwave-mode' is first called." 1066 :group 'idlwave-misc 1067 :type 'boolean) 1068 1069(defcustom idlwave-default-font-lock-items 1070 '(pros-and-functions batch-files idlwave-idl-keywords label goto 1071 common-blocks class-arrows) 1072 "Items which should be fontified on the default fontification level 2. 1073IDLWAVE defines 3 levels of fontification. Level 1 is very little, level 3 1074is everything and level 2 is specified by this list. 1075This variable must be set before IDLWAVE gets loaded. It is 1076a list of symbols, the following symbols are allowed. 1077 1078pros-and-functions Procedure and Function definitions 1079batch-files Batch Files 1080idlwave-idl-keywords IDL Keywords 1081label Statement Labels 1082goto Goto Statements 1083common-blocks Common Blocks 1084keyword-parameters Keyword Parameters in routine definitions and calls 1085system-variables System Variables 1086fixme FIXME: Warning in comments (on XEmacs only v. 21.0 and up) 1087class-arrows Object Arrows with class property" 1088 :group 'idlwave-misc 1089 :type '(set 1090 :inline t :greedy t 1091 (const :tag "Procedure and Function definitions" pros-and-functions) 1092 (const :tag "Batch Files" batch-files) 1093 (const :tag "IDL Keywords (reserved words)" idlwave-idl-keywords) 1094 (const :tag "Statement Labels" label) 1095 (const :tag "Goto Statements" goto) 1096 (const :tag "Tags in Structure Definition" structtag) 1097 (const :tag "Structure Name" structname) 1098 (const :tag "Common Blocks" common-blocks) 1099 (const :tag "Keyword Parameters" keyword-parameters) 1100 (const :tag "System Variables" system-variables) 1101 (const :tag "FIXME: Warning" fixme) 1102 (const :tag "Object Arrows with class property " class-arrows))) 1103 1104(defcustom idlwave-mode-hook nil 1105 "Normal hook. Executed when a buffer is put into `idlwave-mode'." 1106 :group 'idlwave-misc 1107 :type 'hook) 1108 1109(defcustom idlwave-load-hook nil 1110 "Normal hook. Executed when idlwave.el is loaded." 1111 :group 'idlwave-misc 1112 :type 'hook) 1113 1114(defvar idlwave-experimental nil 1115 "Non-nil means turn on a few experimental features. 1116This variable is only for the maintainer, to test difficult stuff, 1117while still distributing stable releases. 1118As a user, you should not set this to t.") 1119 1120;;; 1121;;; End customization variables section 1122;;; 1123 1124;;; Non customization variables 1125 1126;;; font-lock mode - Additions by Phil Williams, Ulrik Dickow and 1127;;; Simon Marshall <simon_at_gnu.ai.mit.edu> 1128;;; and Carsten Dominik... 1129 1130;; The following are the reserved words in IDL. Maybe we should 1131;; highlight some more stuff as well? 1132;; Procedure declarations. Fontify keyword plus procedure name. 1133(defvar idlwave-idl-keywords 1134 ;; To update this regexp, update the list of keywords and 1135 ;; evaluate the form. 1136 ;; (insert 1137 ;; (prin1-to-string 1138 ;; (concat 1139 ;; "\\<\\(" 1140 ;; (regexp-opt 1141 ;; '("||" "&&" "and" "or" "xor" "not" 1142 ;; "eq" "ge" "gt" "le" "lt" "ne" 1143 ;; "for" "do" "endfor" 1144 ;; "if" "then" "endif" "else" "endelse" 1145 ;; "case" "of" "endcase" 1146 ;; "switch" "break" "continue" "endswitch" 1147 ;; "begin" "end" 1148 ;; "repeat" "until" "endrep" 1149 ;; "while" "endwhile" 1150 ;; "goto" "return" 1151 ;; "inherits" "mod" 1152 ;; "compile_opt" "forward_function" 1153 ;; "on_error" "on_ioerror")) ; on_error is not officially reserved 1154 ;; "\\)\\>"))) 1155 "\\<\\(&&\\|and\\|b\\(egin\\|reak\\)\\|c\\(ase\\|o\\(mpile_opt\\|ntinue\\)\\)\\|do\\|e\\(lse\\|nd\\(case\\|else\\|for\\|if\\|rep\\|switch\\|while\\)?\\|q\\)\\|for\\(ward_function\\)?\\|g\\(oto\\|[et]\\)\\|i\\(f\\|nherits\\)\\|l[et]\\|mod\\|n\\(e\\|ot\\)\\|o\\(n_\\(error\\|ioerror\\)\\|[fr]\\)\\|re\\(peat\\|turn\\)\\|switch\\|then\\|until\\|while\\|xor\\|||\\)\\>") 1156 1157 1158(let* (;; Procedure declarations. Fontify keyword plus procedure name. 1159 ;; Function declarations. Fontify keyword plus function name. 1160 (pros-and-functions 1161 '("\\<\\(function\\|pro\\)\\>[ \t]+\\(\\sw+\\(::\\sw+\\)?\\)" 1162 (1 font-lock-keyword-face) 1163 (2 font-lock-function-name-face nil t))) 1164 1165 ;; Common blocks 1166 (common-blocks 1167 '("\\<\\(common\\)\\>[ \t]*\\(\\sw+\\)?[ \t]*,?" 1168 (1 font-lock-keyword-face) ; "common" 1169 (2 font-lock-reference-face nil t) ; block name 1170 ("[ \t]*\\(\\sw+\\)[ ,]*" 1171 ;; Start with point after block name and comma 1172 (goto-char (match-end 0)) ; needed for XEmacs, could be nil 1173 nil 1174 (1 font-lock-variable-name-face) ; variable names 1175 ))) 1176 1177 ;; Batch files 1178 (batch-files 1179 '("^[ \t]*\\(@[^ \t\n]+\\)" (1 font-lock-string-face))) 1180 1181 ;; FIXME warning. 1182 (fixme 1183 '("\\<FIXME:" (0 font-lock-warning-face t))) 1184 1185 ;; Labels 1186 (label 1187 '("^[ \t]*\\([a-zA-Z]\\sw*:\\)" (1 font-lock-reference-face))) 1188 1189 ;; The goto statement and its label 1190 (goto 1191 '("\\(goto\\)[ \t]*,[ \t]*\\([a-zA-Z]\\sw*\\)" 1192 (1 font-lock-keyword-face) 1193 (2 font-lock-reference-face))) 1194 1195 ;; Tags in structure definitions. Note that this definition 1196 ;; actually collides with labels, so we have to use the same 1197 ;; face. It also matches named subscript ranges, 1198 ;; e.g. vec{bottom:top]. No good way around this. 1199 (structtag 1200 '("\\<\\([a-zA-Z][a-zA-Z0-9_]*:\\)[^:]" (1 font-lock-reference-face))) 1201 1202 ;; Structure names 1203 (structname 1204 '("\\({\\|\\<inherits\\s-\\)\\s-*\\([a-zA-Z][a-zA-Z0-9_]*\\)[},\t \n]" 1205 (2 font-lock-function-name-face))) 1206 1207 ;; Keyword parameters, like /xlog or ,xrange=[] 1208 ;; This is anchored to the comma preceeding the keyword. 1209 ;; Treats continuation lines, works only during whole buffer 1210 ;; fontification. Slow, use it only in fancy fontification. 1211 (keyword-parameters 1212 '("\\(,\\|[a-zA-Z0-9_](\\)[ \t]*\\(\\$[ \t]*\\(;.*\\)?\n\\([ \t]*\\(;.*\\)?\n\\)*[ \t]*\\)?\\(/[a-zA-Z_]\\sw*\\|[a-zA-Z_]\\sw*[ \t]*=\\)" 1213 (6 font-lock-reference-face))) 1214 1215 ;; System variables start with a bang. 1216 (system-variables 1217 '("\\(![a-zA-Z_0-9]+\\(\\.\\sw+\\)?\\)" 1218 (1 font-lock-variable-name-face))) 1219 1220 ;; Special and unusual operators (not used because too noisy) 1221 (special-operators 1222 '("[<>#]" (0 font-lock-keyword-face))) 1223 1224 ;; All operators (not used because too noisy) 1225 (all-operators 1226 '("[-*^#+<>/]" (0 font-lock-keyword-face))) 1227 1228 ;; Arrows with text property `idlwave-class' 1229 (class-arrows 1230 '(idlwave-match-class-arrows (0 idlwave-class-arrow-face)))) 1231 1232 (defconst idlwave-font-lock-keywords-1 1233 (list pros-and-functions batch-files) 1234 "Subdued level highlighting for IDLWAVE mode.") 1235 1236 (defconst idlwave-font-lock-keywords-2 1237 (mapcar 'symbol-value idlwave-default-font-lock-items) 1238 "Medium level highlighting for IDLWAVE mode.") 1239 1240 (defconst idlwave-font-lock-keywords-3 1241 (list pros-and-functions 1242 batch-files 1243 idlwave-idl-keywords 1244 label goto 1245 structtag 1246 structname 1247 common-blocks 1248 keyword-parameters 1249 system-variables 1250 class-arrows) 1251 "Gaudy level highlighting for IDLWAVE mode.")) 1252 1253(defun idlwave-match-class-arrows (limit) 1254 ;; Match an object arrow with class property 1255 (and idlwave-store-inquired-class 1256 (re-search-forward "->" limit 'limit) 1257 (get-text-property (match-beginning 0) 'idlwave-class))) 1258 1259(defvar idlwave-font-lock-keywords idlwave-font-lock-keywords-2 1260 "Default expressions to highlight in IDLWAVE mode.") 1261 1262(defvar idlwave-font-lock-defaults 1263 '((idlwave-font-lock-keywords 1264 idlwave-font-lock-keywords-1 1265 idlwave-font-lock-keywords-2 1266 idlwave-font-lock-keywords-3) 1267 nil t 1268 ((?$ . "w") (?_ . "w") (?. . "w") (?| . "w") (?& . "w")) 1269 beginning-of-line)) 1270 1271(put 'idlwave-mode 'font-lock-defaults 1272 idlwave-font-lock-defaults) ; XEmacs 1273 1274(defconst idlwave-comment-line-start-skip "^[ \t]*;" 1275 "Regexp to match the start of a full-line comment. 1276That is the _beginning_ of a line containing a comment delimiter `;' preceded 1277only by whitespace.") 1278 1279(defconst idlwave-begin-block-reg 1280 "\\<\\(pro\\|function\\|begin\\|case\\|switch\\)\\>" 1281 "Regular expression to find the beginning of a block. The case does 1282not matter. The search skips matches in comments.") 1283 1284(defconst idlwave-begin-unit-reg "^\\s-*\\(pro\\|function\\)\\>\\|\\`" 1285 "Regular expression to find the beginning of a unit. The case does 1286not matter.") 1287 1288(defconst idlwave-end-unit-reg "^\\s-*\\(pro\\|function\\)\\>\\|\\'" 1289 "Regular expression to find the line that indicates the end of unit. 1290This line is the end of buffer or the start of another unit. The case does 1291not matter. The search skips matches in comments.") 1292 1293(defconst idlwave-continue-line-reg "\\<\\$" 1294 "Regular expression to match a continued line.") 1295 1296(defconst idlwave-end-block-reg 1297 "\\<end\\(\\|case\\|switch\\|else\\|for\\|if\\|rep\\|while\\)\\>" 1298 "Regular expression to find the end of a block. The case does 1299not matter. The search skips matches found in comments.") 1300 1301(defconst idlwave-block-matches 1302 '(("pro" . "end") 1303 ("function" . "end") 1304 ("case" . "endcase") 1305 ("else" . "endelse") 1306 ("for" . "endfor") 1307 ("then" . "endif") 1308 ("repeat" . "endrep") 1309 ("switch" . "endswitch") 1310 ("while" . "endwhile")) 1311 "Matches between statements and the corresponding END variant. 1312The cars are the reserved words starting a block. If the block really 1313begins with BEGIN, the cars are the reserved words before the begin 1314which can be used to identify the block type. 1315This is used to check for the correct END type, to close blocks and 1316to expand generic end statements to their detailed form.") 1317 1318(defconst idlwave-block-match-regexp 1319 "\\<\\(else\\|for\\|then\\|repeat\\|while\\)\\>" 1320"Regular expression matching reserved words which can stand before 1321blocks starting with a BEGIN statement. The matches must have associations 1322`idlwave-block-matches'") 1323 1324(defconst idlwave-identifier "[a-zA-Z_][a-zA-Z0-9$_]*" 1325 "Regular expression matching an IDL identifier.") 1326 1327(defconst idlwave-sysvar (concat "!" idlwave-identifier) 1328 "Regular expression matching IDL system variables.") 1329 1330(defconst idlwave-variable (concat idlwave-identifier "\\|" idlwave-sysvar) 1331 "Regular expression matching IDL variable names.") 1332 1333(defconst idlwave-label (concat idlwave-identifier ":") 1334 "Regular expression matching IDL labels.") 1335 1336(defconst idlwave-method-call (concat idlwave-identifier "\\s *->" 1337 "\\(\\s *" idlwave-identifier "::\\)?" 1338)) 1339 1340(defconst idlwave-statement-match 1341 (list 1342 ;; "endif else" is the only possible "end" that can be 1343 ;; followed by a statement on the same line. 1344 '(endelse . ("end\\(\\|if\\)\\s +else" "end\\(\\|if\\)\\s +else")) 1345 ;; all other "end"s can not be followed by a statement. 1346 (cons 'end (list idlwave-end-block-reg nil)) 1347 '(if . ("if\\>" "then")) 1348 '(for . ("for\\>" "do")) 1349 '(begin . ("begin\\>" nil)) 1350 '(pdef . ("pro\\>\\|function\\>" nil)) 1351 '(while . ("while\\>" "do")) 1352 '(repeat . ("repeat\\>" "repeat")) 1353 '(goto . ("goto\\>" nil)) 1354 '(case . ("case\\>" nil)) 1355 '(switch . ("switch\\>" nil)) 1356 (cons 'call (list (concat "\\(" idlwave-variable "\\) *= *" 1357 "\\(" idlwave-method-call "\\s *\\)?" 1358 idlwave-identifier 1359 "\\s *(") nil)) 1360 (cons 'call (list (concat 1361 "\\(" idlwave-method-call "\\s *\\)?" 1362 idlwave-identifier 1363 "\\( *\\($\\|\\$\\)\\|\\s *,\\)") nil)) 1364 (cons 'assign (list (concat 1365 "\\(" idlwave-variable "\\) *=") nil))) 1366 1367 "Associated list of statement matching regular expressions. 1368Each regular expression matches the start of an IDL statement. The 1369first element of each association is a symbol giving the statement 1370type. The associated value is a list. The first element of this list 1371is a regular expression matching the start of an IDL statement for 1372identifying the statement type. The second element of this list is a 1373regular expression for finding a substatement for the type. The 1374substatement starts after the end of the found match modulo 1375whitespace. If it is nil then the statement has no substatement. The 1376list order matters since matching an assignment statement exactly is 1377not possible without parsing. Thus assignment statement become just 1378the leftover unidentified statements containing an equal sign." ) 1379 1380(defvar idlwave-fill-function 'auto-fill-function 1381 "IDL mode auto fill function.") 1382 1383(defvar idlwave-comment-indent-function 'comment-indent-function 1384 "IDL mode comment indent function.") 1385 1386;; Note that this is documented in the v18 manuals as being a string 1387;; of length one rather than a single character. 1388;; The code in this file accepts either format for compatibility. 1389(defvar idlwave-comment-indent-char ?\ 1390 "Character to be inserted for IDL comment indentation. 1391Normally a space.") 1392 1393(defconst idlwave-continuation-char ?$ 1394 "Character which is inserted as a last character on previous line by 1395 \\[idlwave-split-line] to begin a continuation line. Normally $.") 1396 1397(defconst idlwave-mode-version "6.1_em22") 1398 1399(defmacro idlwave-keyword-abbrev (&rest args) 1400 "Creates a function for abbrev hooks to call `idlwave-check-abbrev' with args." 1401 `(quote (lambda () 1402 ,(append '(idlwave-check-abbrev) args)))) 1403 1404;; If I take the time I can replace idlwave-keyword-abbrev with 1405;; idlwave-code-abbrev and remove the quoted abbrev check from 1406;; idlwave-check-abbrev. Then, e.g, (idlwave-keyword-abbrev 0 t) becomes 1407;; (idlwave-code-abbrev idlwave-check-abbrev 0 t). In fact I should change 1408;; the name of idlwave-check-abbrev to something like idlwave-modify-abbrev. 1409 1410(defmacro idlwave-code-abbrev (&rest args) 1411 "Creates a function for abbrev hooks that ensures abbrevs are not quoted. 1412Specifically, if the abbrev is in a comment or string it is unexpanded. 1413Otherwise ARGS forms a list that is evaluated." 1414 `(quote (lambda () 1415 ,(prin1-to-string args) ;; Puts the code in the doc string 1416 (if (idlwave-quoted) 1417 (progn (unexpand-abbrev) nil) 1418 ,(append args))))) 1419 1420(defvar idlwave-mode-map (make-sparse-keymap) 1421 "Keymap used in IDL mode.") 1422 1423(defvar idlwave-mode-syntax-table (make-syntax-table) 1424 "Syntax table in use in `idlwave-mode' buffers.") 1425 1426(modify-syntax-entry ?+ "." idlwave-mode-syntax-table) 1427(modify-syntax-entry ?- "." idlwave-mode-syntax-table) 1428(modify-syntax-entry ?* "." idlwave-mode-syntax-table) 1429(modify-syntax-entry ?/ "." idlwave-mode-syntax-table) 1430(modify-syntax-entry ?^ "." idlwave-mode-syntax-table) 1431(modify-syntax-entry ?# "." idlwave-mode-syntax-table) 1432(modify-syntax-entry ?= "." idlwave-mode-syntax-table) 1433(modify-syntax-entry ?% "." idlwave-mode-syntax-table) 1434(modify-syntax-entry ?< "." idlwave-mode-syntax-table) 1435(modify-syntax-entry ?> "." idlwave-mode-syntax-table) 1436(modify-syntax-entry ?\' "\"" idlwave-mode-syntax-table) 1437(modify-syntax-entry ?\" "\"" idlwave-mode-syntax-table) 1438(modify-syntax-entry ?\\ "." idlwave-mode-syntax-table) 1439(modify-syntax-entry ?_ "_" idlwave-mode-syntax-table) 1440(modify-syntax-entry ?{ "(}" idlwave-mode-syntax-table) 1441(modify-syntax-entry ?} "){" idlwave-mode-syntax-table) 1442(modify-syntax-entry ?$ "_" idlwave-mode-syntax-table) 1443(modify-syntax-entry ?. "." idlwave-mode-syntax-table) 1444(modify-syntax-entry ?\; "<" idlwave-mode-syntax-table) 1445(modify-syntax-entry ?\n ">" idlwave-mode-syntax-table) 1446(modify-syntax-entry ?\f ">" idlwave-mode-syntax-table) 1447 1448(defvar idlwave-find-symbol-syntax-table 1449 (copy-syntax-table idlwave-mode-syntax-table) 1450 "Syntax table that treats symbol characters as word characters.") 1451 1452(modify-syntax-entry ?$ "w" idlwave-find-symbol-syntax-table) 1453(modify-syntax-entry ?_ "w" idlwave-find-symbol-syntax-table) 1454(modify-syntax-entry ?! "w" idlwave-find-symbol-syntax-table) 1455(modify-syntax-entry ?. "w" idlwave-find-symbol-syntax-table) 1456 1457(defmacro idlwave-with-special-syntax (&rest body) 1458 "Execute BODY with a different syntax table." 1459 `(let ((saved-syntax (syntax-table))) 1460 (unwind-protect 1461 (progn 1462 (set-syntax-table idlwave-find-symbol-syntax-table) 1463 ,@body) 1464 (set-syntax-table saved-syntax)))) 1465 1466;(defmacro idlwave-with-special-syntax1 (&rest body) 1467; "Execute BODY with a different syntax table." 1468; `(let ((saved-syntax (syntax-table))) 1469; (unwind-protect 1470; (progn 1471; (set-syntax-table idlwave-find-symbol-syntax-table) 1472; ,@body) 1473; (set-syntax-table saved-syntax)))) 1474 1475(defun idlwave-action-and-binding (key cmd &optional select) 1476 "KEY and CMD are made into a key binding and an indent action. 1477KEY is a string - same as for the `define-key' function. CMD is a 1478function of no arguments or a list to be evaluated. CMD is bound to 1479KEY in `idlwave-mode-map' by defining an anonymous function calling 1480`self-insert-command' followed by CMD. If KEY contains more than one 1481character a binding will only be set if SELECT is 'both. 1482 1483\(KEY . CMD\) is also placed in the `idlwave-indent-expand-table', 1484replacing any previous value for KEY. If a binding is not set then it 1485will instead be placed in `idlwave-indent-action-table'. 1486 1487If the optional argument SELECT is nil then an action and binding are 1488created. If SELECT is 'noaction, then a binding is always set and no 1489action is created. If SELECT is 'both then an action and binding 1490will both be created even if KEY contains more than one character. 1491Otherwise, if SELECT is non-nil then only an action is created. 1492 1493Some examples: 1494No spaces before and 1 after a comma 1495 (idlwave-action-and-binding \",\" '(idlwave-surround 0 1)) 1496A minimum of 1 space before and after `=' (see `idlwave-expand-equal'). 1497 (idlwave-action-and-binding \"=\" '(idlwave-expand-equal -1 -1)) 1498Capitalize system variables - action only 1499 (idlwave-action-and-binding idlwave-sysvar '(capitalize-word 1) t)" 1500 (if (not (equal select 'noaction)) 1501 ;; Add action 1502 (let* ((table (if select 'idlwave-indent-action-table 1503 'idlwave-indent-expand-table)) 1504 (table-key (regexp-quote key)) 1505 (cell (assoc table-key (eval table)))) 1506 (if cell 1507 ;; Replace action command 1508 (setcdr cell cmd) 1509 ;; New action 1510 (set table (append (eval table) (list (cons table-key cmd))))))) 1511 ;; Make key binding for action 1512 (if (or (and (null select) (= (length key) 1)) 1513 (equal select 'noaction) 1514 (equal select 'both)) 1515 (define-key idlwave-mode-map key 1516 (append '(lambda () 1517 (interactive) 1518 (self-insert-command 1)) 1519 (list (if (listp cmd) 1520 cmd 1521 (list cmd))))))) 1522 1523(fset 'idlwave-debug-map (make-sparse-keymap)) 1524 1525(define-key idlwave-mode-map "\C-c " 'idlwave-hard-tab) 1526(define-key idlwave-mode-map [(control tab)] 'idlwave-hard-tab) 1527;(define-key idlwave-mode-map "\C-c\C- " 'idlwave-hard-tab) 1528(define-key idlwave-mode-map "'" 'idlwave-show-matching-quote) 1529(define-key idlwave-mode-map "\"" 'idlwave-show-matching-quote) 1530(define-key idlwave-mode-map "\C-g" 'idlwave-keyboard-quit) 1531(define-key idlwave-mode-map "\C-c;" 'idlwave-toggle-comment-region) 1532(define-key idlwave-mode-map "\C-\M-a" 'idlwave-beginning-of-subprogram) 1533(define-key idlwave-mode-map "\C-\M-e" 'idlwave-end-of-subprogram) 1534(define-key idlwave-mode-map "\C-c{" 'idlwave-beginning-of-block) 1535(define-key idlwave-mode-map "\C-c}" 'idlwave-end-of-block) 1536(define-key idlwave-mode-map "\C-c]" 'idlwave-close-block) 1537(define-key idlwave-mode-map [(meta control h)] 'idlwave-mark-subprogram) 1538(define-key idlwave-mode-map "\M-\C-n" 'idlwave-forward-block) 1539(define-key idlwave-mode-map "\M-\C-p" 'idlwave-backward-block) 1540(define-key idlwave-mode-map "\M-\C-d" 'idlwave-down-block) 1541(define-key idlwave-mode-map "\M-\C-u" 'idlwave-backward-up-block) 1542(define-key idlwave-mode-map "\M-\r" 'idlwave-split-line) 1543(define-key idlwave-mode-map "\M-\C-q" 'idlwave-indent-subprogram) 1544(define-key idlwave-mode-map "\C-c\C-p" 'idlwave-previous-statement) 1545(define-key idlwave-mode-map "\C-c\C-n" 'idlwave-next-statement) 1546;; (define-key idlwave-mode-map "\r" 'idlwave-newline) 1547;; (define-key idlwave-mode-map "\t" 'idlwave-indent-line) 1548(define-key idlwave-mode-map [(shift iso-lefttab)] 'idlwave-indent-statement) 1549(define-key idlwave-mode-map "\C-c\C-a" 'idlwave-auto-fill-mode) 1550(define-key idlwave-mode-map "\M-q" 'idlwave-fill-paragraph) 1551(define-key idlwave-mode-map "\M-s" 'idlwave-edit-in-idlde) 1552(define-key idlwave-mode-map "\C-c\C-h" 'idlwave-doc-header) 1553(define-key idlwave-mode-map "\C-c\C-m" 'idlwave-doc-modification) 1554(define-key idlwave-mode-map "\C-c\C-c" 'idlwave-case) 1555(define-key idlwave-mode-map "\C-c\C-d" 'idlwave-debug-map) 1556(when (and (boundp 'idlwave-shell-debug-modifiers) 1557 (listp idlwave-shell-debug-modifiers) 1558 (not (equal idlwave-shell-debug-modifiers '()))) 1559 ;; Bind the debug commands also with the special modifiers. 1560 (let ((shift (memq 'shift idlwave-shell-debug-modifiers)) 1561 (mods-noshift (delq 'shift 1562 (copy-sequence idlwave-shell-debug-modifiers)))) 1563 (define-key idlwave-mode-map 1564 (vector (append mods-noshift (list (if shift ?C ?c)))) 1565 'idlwave-shell-save-and-run) 1566 (define-key idlwave-mode-map 1567 (vector (append mods-noshift (list (if shift ?B ?b)))) 1568 'idlwave-shell-break-here) 1569 (define-key idlwave-mode-map 1570 (vector (append mods-noshift (list (if shift ?E ?e)))) 1571 'idlwave-shell-run-region))) 1572(define-key idlwave-mode-map "\C-c\C-d\C-c" 'idlwave-shell-save-and-run) 1573(define-key idlwave-mode-map "\C-c\C-d\C-b" 'idlwave-shell-break-here) 1574(define-key idlwave-mode-map "\C-c\C-d\C-e" 'idlwave-shell-run-region) 1575(define-key idlwave-mode-map "\C-c\C-f" 'idlwave-for) 1576;; (define-key idlwave-mode-map "\C-c\C-f" 'idlwave-function) 1577;; (define-key idlwave-mode-map "\C-c\C-p" 'idlwave-procedure) 1578(define-key idlwave-mode-map "\C-c\C-r" 'idlwave-repeat) 1579(define-key idlwave-mode-map "\C-c\C-w" 'idlwave-while) 1580(define-key idlwave-mode-map "\C-c\C-k" 'idlwave-kill-autoloaded-buffers) 1581(define-key idlwave-mode-map "\C-c\C-s" 'idlwave-shell) 1582(define-key idlwave-mode-map "\C-c\C-l" 'idlwave-shell-recenter-shell-window) 1583(define-key idlwave-mode-map "\C-c\C-b" 'idlwave-list-buffer-load-path-shadows) 1584(autoload 'idlwave-shell "idlw-shell" 1585 "Run an inferior IDL, with I/O through buffer `(idlwave-shell-buffer)'." t) 1586(autoload 'idlwave-shell-send-command "idlw-shell") 1587(autoload 'idlwave-shell-recenter-shell-window "idlw-shell" 1588 "Run `idlwave-shell' and switch back to current window" t) 1589(autoload 'idlwave-shell-save-and-run "idlw-shell" 1590 "Save and run buffer under the shell." t) 1591(autoload 'idlwave-shell-break-here "idlw-shell" 1592 "Set breakpoint in current line." t) 1593(autoload 'idlwave-shell-run-region "idlw-shell" 1594 "Compile and run the region." t) 1595(define-key idlwave-mode-map "\C-c\C-v" 'idlwave-find-module) 1596(define-key idlwave-mode-map "\C-c\C-t" 'idlwave-find-module-this-file) 1597(define-key idlwave-mode-map "\C-c?" 'idlwave-routine-info) 1598(define-key idlwave-mode-map "\M-?" 'idlwave-context-help) 1599(define-key idlwave-mode-map [(control meta ?\?)] 1600 'idlwave-help-assistant-help-with-topic) 1601;; Pickup both forms of Esc/Meta binding 1602(define-key idlwave-mode-map [(meta tab)] 'idlwave-complete) 1603(define-key idlwave-mode-map [?\e?\t] 'idlwave-complete) 1604(define-key idlwave-mode-map "\M-\C-i" 'idlwave-complete) 1605(define-key idlwave-mode-map "\C-c\C-i" 'idlwave-update-routine-info) 1606(define-key idlwave-mode-map "\C-c=" 'idlwave-resolve) 1607(define-key idlwave-mode-map 1608 (if (featurep 'xemacs) [(shift button3)] [(shift mouse-3)]) 1609 'idlwave-mouse-context-help) 1610 1611;; Set action and key bindings. 1612;; See description of the function `idlwave-action-and-binding'. 1613;; Automatically add spaces for the following characters 1614 1615;; Actions for & are complicated by && 1616(idlwave-action-and-binding "&" 'idlwave-custom-ampersand-surround) 1617 1618;; Automatically add spaces to equal sign if not keyword. This needs 1619;; to go ahead of > and <, so >= and <= will be treated correctly 1620(idlwave-action-and-binding "=" '(idlwave-expand-equal -1 -1)) 1621 1622;; Actions for > and < are complicated by >=, <=, and ->... 1623(idlwave-action-and-binding "<" '(idlwave-custom-ltgtr-surround nil)) 1624(idlwave-action-and-binding ">" '(idlwave-custom-ltgtr-surround 'gtr)) 1625 1626(idlwave-action-and-binding "," '(idlwave-surround 0 -1 1)) 1627 1628 1629;;; 1630;;; Abbrev Section 1631;;; 1632;;; When expanding abbrevs and the abbrev hook moves backward, an extra 1633;;; space is inserted (this is the space typed by the user to expanded 1634;;; the abbrev). 1635;;; 1636(defvar idlwave-mode-abbrev-table nil 1637 "Abbreviation table used for IDLWAVE mode") 1638(define-abbrev-table 'idlwave-mode-abbrev-table ()) 1639 1640(defun idlwave-define-abbrev (name expansion hook &optional noprefix table) 1641 "Define-abbrev with backward compatibility. 1642 1643If NOPREFIX is non-nil, don't prepend prefix character. Installs into 1644idlwave-mode-abbrev-table unless TABLE is non-nil." 1645 (let ((abbrevs-changed nil) ;; mask the current value to avoid save 1646 (args (list (or table idlwave-mode-abbrev-table) 1647 (if noprefix name (concat idlwave-abbrev-start-char name)) 1648 expansion 1649 hook))) 1650 (condition-case nil 1651 (apply 'define-abbrev (append args '(0 t))) 1652 (error (apply 'define-abbrev args))))) 1653 1654(condition-case nil 1655 (modify-syntax-entry (string-to-char idlwave-abbrev-start-char) 1656 "w" idlwave-mode-syntax-table) 1657 (error nil)) 1658 1659;; 1660;; Templates 1661;; 1662(idlwave-define-abbrev "c" "" (idlwave-code-abbrev idlwave-case)) 1663(idlwave-define-abbrev "sw" "" (idlwave-code-abbrev idlwave-switch)) 1664(idlwave-define-abbrev "f" "" (idlwave-code-abbrev idlwave-for)) 1665(idlwave-define-abbrev "fu" "" (idlwave-code-abbrev idlwave-function)) 1666(idlwave-define-abbrev "pr" "" (idlwave-code-abbrev idlwave-procedure)) 1667(idlwave-define-abbrev "r" "" (idlwave-code-abbrev idlwave-repeat)) 1668(idlwave-define-abbrev "w" "" (idlwave-code-abbrev idlwave-while)) 1669(idlwave-define-abbrev "i" "" (idlwave-code-abbrev idlwave-if)) 1670(idlwave-define-abbrev "elif" "" (idlwave-code-abbrev idlwave-elif)) 1671;; 1672;; Keywords, system functions, conversion routines 1673;; 1674(idlwave-define-abbrev "ap" "arg_present()" (idlwave-keyword-abbrev 1)) 1675(idlwave-define-abbrev "b" "begin" (idlwave-keyword-abbrev 0 t)) 1676(idlwave-define-abbrev "co" "common" (idlwave-keyword-abbrev 0 t)) 1677(idlwave-define-abbrev "cb" "byte()" (idlwave-keyword-abbrev 1)) 1678(idlwave-define-abbrev "cx" "fix()" (idlwave-keyword-abbrev 1)) 1679(idlwave-define-abbrev "cl" "long()" (idlwave-keyword-abbrev 1)) 1680(idlwave-define-abbrev "cf" "float()" (idlwave-keyword-abbrev 1)) 1681(idlwave-define-abbrev "cs" "string()" (idlwave-keyword-abbrev 1)) 1682(idlwave-define-abbrev "cc" "complex()" (idlwave-keyword-abbrev 1)) 1683(idlwave-define-abbrev "cd" "double()" (idlwave-keyword-abbrev 1)) 1684(idlwave-define-abbrev "e" "else" (idlwave-keyword-abbrev 0 t)) 1685(idlwave-define-abbrev "ec" "endcase" 'idlwave-show-begin) 1686(idlwave-define-abbrev "es" "endswitch" 'idlwave-show-begin) 1687(idlwave-define-abbrev "ee" "endelse" 'idlwave-show-begin) 1688(idlwave-define-abbrev "ef" "endfor" 'idlwave-show-begin) 1689(idlwave-define-abbrev "ei" "endif else if" 'idlwave-show-begin) 1690(idlwave-define-abbrev "el" "endif else" 'idlwave-show-begin) 1691(idlwave-define-abbrev "en" "endif" 'idlwave-show-begin) 1692(idlwave-define-abbrev "er" "endrep" 'idlwave-show-begin) 1693(idlwave-define-abbrev "ew" "endwhile" 'idlwave-show-begin) 1694(idlwave-define-abbrev "g" "goto," (idlwave-keyword-abbrev 0 t)) 1695(idlwave-define-abbrev "h" "help," (idlwave-keyword-abbrev 0)) 1696(idlwave-define-abbrev "k" "keyword_set()" (idlwave-keyword-abbrev 1)) 1697(idlwave-define-abbrev "n" "n_elements()" (idlwave-keyword-abbrev 1)) 1698(idlwave-define-abbrev "on" "on_error," (idlwave-keyword-abbrev 0)) 1699(idlwave-define-abbrev "oi" "on_ioerror," (idlwave-keyword-abbrev 0 1)) 1700(idlwave-define-abbrev "ow" "openw," (idlwave-keyword-abbrev 0)) 1701(idlwave-define-abbrev "or" "openr," (idlwave-keyword-abbrev 0)) 1702(idlwave-define-abbrev "ou" "openu," (idlwave-keyword-abbrev 0)) 1703(idlwave-define-abbrev "p" "print," (idlwave-keyword-abbrev 0)) 1704(idlwave-define-abbrev "pt" "plot," (idlwave-keyword-abbrev 0)) 1705(idlwave-define-abbrev "re" "read," (idlwave-keyword-abbrev 0)) 1706(idlwave-define-abbrev "rf" "readf," (idlwave-keyword-abbrev 0)) 1707(idlwave-define-abbrev "ru" "readu," (idlwave-keyword-abbrev 0)) 1708(idlwave-define-abbrev "rt" "return" (idlwave-keyword-abbrev 0)) 1709(idlwave-define-abbrev "sc" "strcompress()" (idlwave-keyword-abbrev 1)) 1710(idlwave-define-abbrev "sn" "strlen()" (idlwave-keyword-abbrev 1)) 1711(idlwave-define-abbrev "sl" "strlowcase()" (idlwave-keyword-abbrev 1)) 1712(idlwave-define-abbrev "su" "strupcase()" (idlwave-keyword-abbrev 1)) 1713(idlwave-define-abbrev "sm" "strmid()" (idlwave-keyword-abbrev 1)) 1714(idlwave-define-abbrev "sp" "strpos()" (idlwave-keyword-abbrev 1)) 1715(idlwave-define-abbrev "st" "strput()" (idlwave-keyword-abbrev 1)) 1716(idlwave-define-abbrev "sr" "strtrim()" (idlwave-keyword-abbrev 1)) 1717(idlwave-define-abbrev "t" "then" (idlwave-keyword-abbrev 0 t)) 1718(idlwave-define-abbrev "u" "until" (idlwave-keyword-abbrev 0 t)) 1719(idlwave-define-abbrev "wu" "writeu," (idlwave-keyword-abbrev 0)) 1720(idlwave-define-abbrev "iap" "if arg_present() then" (idlwave-keyword-abbrev 6)) 1721(idlwave-define-abbrev "ik" "if keyword_set() then" (idlwave-keyword-abbrev 6)) 1722(idlwave-define-abbrev "ine" "if n_elements() eq 0 then" (idlwave-keyword-abbrev 11)) 1723(idlwave-define-abbrev "inn" "if n_elements() ne 0 then" (idlwave-keyword-abbrev 11)) 1724(idlwave-define-abbrev "np" "n_params()" (idlwave-keyword-abbrev 0)) 1725(idlwave-define-abbrev "s" "size()" (idlwave-keyword-abbrev 1)) 1726(idlwave-define-abbrev "wi" "widget_info()" (idlwave-keyword-abbrev 1)) 1727(idlwave-define-abbrev "wc" "widget_control," (idlwave-keyword-abbrev 0)) 1728(idlwave-define-abbrev "pv" "ptr_valid()" (idlwave-keyword-abbrev 1)) 1729(idlwave-define-abbrev "ipv" "if ptr_valid() then" (idlwave-keyword-abbrev 6)) 1730 1731;; This section is reserved words only. (From IDL user manual) 1732;; 1733(idlwave-define-abbrev "and" "and" (idlwave-keyword-abbrev 0 t) t) 1734(idlwave-define-abbrev "begin" "begin" (idlwave-keyword-abbrev 0 t) t) 1735(idlwave-define-abbrev "break" "break" (idlwave-keyword-abbrev 0 t) t) 1736(idlwave-define-abbrev "case" "case" (idlwave-keyword-abbrev 0 t) t) 1737(idlwave-define-abbrev "common" "common" (idlwave-keyword-abbrev 0 t) t) 1738(idlwave-define-abbrev "continue" "continue" (idlwave-keyword-abbrev 0 t) t) 1739(idlwave-define-abbrev "do" "do" (idlwave-keyword-abbrev 0 t) t) 1740(idlwave-define-abbrev "else" "else" (idlwave-keyword-abbrev 0 t) t) 1741(idlwave-define-abbrev "end" "end" 'idlwave-show-begin-check t) 1742(idlwave-define-abbrev "endcase" "endcase" 'idlwave-show-begin-check t) 1743(idlwave-define-abbrev "endelse" "endelse" 'idlwave-show-begin-check t) 1744(idlwave-define-abbrev "endfor" "endfor" 'idlwave-show-begin-check t) 1745(idlwave-define-abbrev "endif" "endif" 'idlwave-show-begin-check t) 1746(idlwave-define-abbrev "endrep" "endrep" 'idlwave-show-begin-check t) 1747(idlwave-define-abbrev "endswitch" "endswitch" 'idlwave-show-begin-check t) 1748(idlwave-define-abbrev "endwhi" "endwhi" 'idlwave-show-begin-check t) 1749(idlwave-define-abbrev "endwhile" "endwhile" 'idlwave-show-begin-check t) 1750(idlwave-define-abbrev "eq" "eq" (idlwave-keyword-abbrev 0 t) t) 1751(idlwave-define-abbrev "for" "for" (idlwave-keyword-abbrev 0 t) t) 1752(idlwave-define-abbrev "function" "function" (idlwave-keyword-abbrev 0 t) t) 1753(idlwave-define-abbrev "ge" "ge" (idlwave-keyword-abbrev 0 t) t) 1754(idlwave-define-abbrev "goto" "goto" (idlwave-keyword-abbrev 0 t) t) 1755(idlwave-define-abbrev "gt" "gt" (idlwave-keyword-abbrev 0 t) t) 1756(idlwave-define-abbrev "if" "if" (idlwave-keyword-abbrev 0 t) t) 1757(idlwave-define-abbrev "le" "le" (idlwave-keyword-abbrev 0 t) t) 1758(idlwave-define-abbrev "lt" "lt" (idlwave-keyword-abbrev 0 t) t) 1759(idlwave-define-abbrev "mod" "mod" (idlwave-keyword-abbrev 0 t) t) 1760(idlwave-define-abbrev "ne" "ne" (idlwave-keyword-abbrev 0 t) t) 1761(idlwave-define-abbrev "not" "not" (idlwave-keyword-abbrev 0 t) t) 1762(idlwave-define-abbrev "of" "of" (idlwave-keyword-abbrev 0 t) t) 1763(idlwave-define-abbrev "on_ioerror" "on_ioerror" (idlwave-keyword-abbrev 0 t) t) 1764(idlwave-define-abbrev "or" "or" (idlwave-keyword-abbrev 0 t) t) 1765(idlwave-define-abbrev "pro" "pro" (idlwave-keyword-abbrev 0 t) t) 1766(idlwave-define-abbrev "repeat" "repeat" (idlwave-keyword-abbrev 0 t) t) 1767(idlwave-define-abbrev "switch" "switch" (idlwave-keyword-abbrev 0 t) t) 1768(idlwave-define-abbrev "then" "then" (idlwave-keyword-abbrev 0 t) t) 1769(idlwave-define-abbrev "until" "until" (idlwave-keyword-abbrev 0 t) t) 1770(idlwave-define-abbrev "while" "while" (idlwave-keyword-abbrev 0 t) t) 1771(idlwave-define-abbrev "xor" "xor" (idlwave-keyword-abbrev 0 t) t) 1772 1773(defvar imenu-create-index-function) 1774(defvar extract-index-name-function) 1775(defvar prev-index-position-function) 1776(defvar imenu-extract-index-name-function) 1777(defvar imenu-prev-index-position-function) 1778;; defined later - so just make the compiler hush 1779(defvar idlwave-mode-menu) 1780(defvar idlwave-mode-debug-menu) 1781 1782;;;###autoload 1783(defun idlwave-mode () 1784 "Major mode for editing IDL source files (version 6.1_em22). 1785 1786The main features of this mode are 1787 17881. Indentation and Formatting 1789 -------------------------- 1790 Like other Emacs programming modes, C-j inserts a newline and indents. 1791 TAB is used for explicit indentation of the current line. 1792 1793 To start a continuation line, use \\[idlwave-split-line]. This 1794 function can also be used in the middle of a line to split the line 1795 at that point. When used inside a long constant string, the string 1796 is split at that point with the `+' concatenation operator. 1797 1798 Comments are indented as follows: 1799 1800 `;;;' Indentation remains unchanged. 1801 `;;' Indent like the surrounding code 1802 `;' Indent to a minimum column. 1803 1804 The indentation of comments starting in column 0 is never changed. 1805 1806 Use \\[idlwave-fill-paragraph] to refill a paragraph inside a 1807 comment. The indentation of the second line of the paragraph 1808 relative to the first will be retained. Use 1809 \\[idlwave-auto-fill-mode] to toggle auto-fill mode for these 1810 comments. When the variable `idlwave-fill-comment-line-only' is 1811 nil, code can also be auto-filled and auto-indented. 1812 1813 To convert pre-existing IDL code to your formatting style, mark the 1814 entire buffer with \\[mark-whole-buffer] and execute 1815 \\[idlwave-expand-region-abbrevs]. Then mark the entire buffer 1816 again followed by \\[indent-region] (`indent-region'). 1817 18182. Routine Info 1819 ------------ 1820 IDLWAVE displays information about the calling sequence and the 1821 accepted keyword parameters of a procedure or function with 1822 \\[idlwave-routine-info]. \\[idlwave-find-module] jumps to the 1823 source file of a module. These commands know about system 1824 routines, all routines in idlwave-mode buffers and (when the 1825 idlwave-shell is active) about all modules currently compiled under 1826 this shell. It also makes use of pre-compiled or custom-scanned 1827 user and library catalogs many popular libraries ship with by 1828 default. Use \\[idlwave-update-routine-info] to update this 1829 information, which is also used for completion (see item 4). 1830 18313. Online IDL Help 1832 --------------- 1833 1834 \\[idlwave-context-help] displays the IDL documentation relevant 1835 for the system variable, keyword, or routines at point. A single 1836 key stroke gets you directly to the right place in the docs. See 1837 the manual to configure where and how the HTML help is displayed. 1838 18394. Completion 1840 ---------- 1841 \\[idlwave-complete] completes the names of procedures, functions 1842 class names, keyword parameters, system variables and tags, class 1843 tags, structure tags, filenames and much more. It is context 1844 sensitive and figures out what is expected at point. Lower case 1845 strings are completed in lower case, other strings in mixed or 1846 upper case. 1847 18485. Code Templates and Abbreviations 1849 -------------------------------- 1850 Many Abbreviations are predefined to expand to code fragments and templates. 1851 The abbreviations start generally with a `\\`. Some examples 1852 1853 \\pr PROCEDURE template 1854 \\fu FUNCTION template 1855 \\c CASE statement template 1856 \\sw SWITCH statement template 1857 \\f FOR loop template 1858 \\r REPEAT Loop template 1859 \\w WHILE loop template 1860 \\i IF statement template 1861 \\elif IF-ELSE statement template 1862 \\b BEGIN 1863 1864 For a full list, use \\[idlwave-list-abbrevs]. Some templates also 1865 have direct keybindings - see the list of keybindings below. 1866 1867 \\[idlwave-doc-header] inserts a documentation header at the 1868 beginning of the current program unit (pro, function or main). 1869 Change log entries can be added to the current program unit with 1870 \\[idlwave-doc-modification]. 1871 18726. Automatic Case Conversion 1873 ------------------------- 1874 The case of reserved words and some abbrevs is controlled by 1875 `idlwave-reserved-word-upcase' and `idlwave-abbrev-change-case'. 1876 18777. Automatic END completion 1878 ------------------------ 1879 If the variable `idlwave-expand-generic-end' is non-nil, each END typed 1880 will be converted to the specific version, like ENDIF, ENDFOR, etc. 1881 18828. Hooks 1883 ----- 1884 Loading idlwave.el runs `idlwave-load-hook'. 1885 Turning on `idlwave-mode' runs `idlwave-mode-hook'. 1886 18879. Documentation and Customization 1888 ------------------------------- 1889 Info documentation for this package is available. Use 1890 \\[idlwave-info] to display (complain to your sysadmin if that does 1891 not work). For Postscript, PDF, and HTML versions of the 1892 documentation, check IDLWAVE's homepage at `http://idlwave.org'. 1893 IDLWAVE has customize support - see the group `idlwave'. 1894 189510.Keybindings 1896 ----------- 1897 Here is a list of all keybindings of this mode. 1898 If some of the key bindings below show with ??, use \\[describe-key] 1899 followed by the key sequence to see what the key sequence does. 1900 1901\\{idlwave-mode-map}" 1902 1903 (interactive) 1904 (kill-all-local-variables) 1905 1906 (if idlwave-startup-message 1907 (message "Emacs IDLWAVE mode version %s." idlwave-mode-version)) 1908 (setq idlwave-startup-message nil) 1909 1910 (setq local-abbrev-table idlwave-mode-abbrev-table) 1911 (set-syntax-table idlwave-mode-syntax-table) 1912 1913 (set (make-local-variable 'indent-line-function) 'idlwave-indent-and-action) 1914 1915 (make-local-variable idlwave-comment-indent-function) 1916 (set idlwave-comment-indent-function 'idlwave-comment-hook) 1917 1918 (set (make-local-variable 'comment-start-skip) ";+[ \t]*") 1919 (set (make-local-variable 'comment-start) ";") 1920 (set (make-local-variable 'comment-add) 1) ; ";;" for new and regions 1921 (set (make-local-variable 'require-final-newline) t) 1922 (set (make-local-variable 'abbrev-all-caps) t) 1923 (set (make-local-variable 'indent-tabs-mode) nil) 1924 (set (make-local-variable 'completion-ignore-case) t) 1925 1926 (use-local-map idlwave-mode-map) 1927 1928 (when (featurep 'easymenu) 1929 (easy-menu-add idlwave-mode-menu idlwave-mode-map) 1930 (easy-menu-add idlwave-mode-debug-menu idlwave-mode-map)) 1931 1932 (setq mode-name "IDLWAVE") 1933 (setq major-mode 'idlwave-mode) 1934 (setq abbrev-mode t) 1935 1936 (set (make-local-variable idlwave-fill-function) 'idlwave-auto-fill) 1937 (setq comment-end "") 1938 (set (make-local-variable 'comment-multi-line) nil) 1939 (set (make-local-variable 'paragraph-separate) 1940 "[ \t\f]*$\\|[ \t]*;+[ \t]*$\\|;+[+=-_*]+$") 1941 (set (make-local-variable 'paragraph-start) "[ \t\f]\\|[ \t]*;+[ \t]") 1942 (set (make-local-variable 'paragraph-ignore-fill-prefix) nil) 1943 (set (make-local-variable 'parse-sexp-ignore-comments) t) 1944 1945 ;; ChangeLog 1946 (set (make-local-variable 'add-log-current-defun-function) 1947 'idlwave-current-routine-fullname) 1948 1949 ;; Set tag table list to use IDLTAGS as file name. 1950 (if (boundp 'tag-table-alist) 1951 (add-to-list 'tag-table-alist '("\\.pro$" . "IDLTAGS"))) 1952 1953 ;; Font-lock additions 1954 ;; Following line is for Emacs - XEmacs uses the corresponding property 1955 ;; on the `idlwave-mode' symbol. 1956 (set (make-local-variable 'font-lock-defaults) idlwave-font-lock-defaults) 1957 (set (make-local-variable 'font-lock-mark-block-function) 1958 'idlwave-mark-subprogram) 1959 (set (make-local-variable 'font-lock-fontify-region-function) 1960 'idlwave-font-lock-fontify-region) 1961 1962 ;; Imenu setup 1963 (set (make-local-variable 'imenu-create-index-function) 1964 'imenu-default-create-index-function) 1965 (set (make-local-variable 'imenu-extract-index-name-function) 1966 'idlwave-unit-name) 1967 (set (make-local-variable 'imenu-prev-index-position-function) 1968 'idlwave-prev-index-position) 1969 1970 ;; HideShow setup 1971 (add-to-list 'hs-special-modes-alist 1972 (list 'idlwave-mode 1973 idlwave-begin-block-reg 1974 idlwave-end-block-reg 1975 ";" 1976 'idlwave-forward-block nil)) 1977 1978 ;; Make a local post-command-hook and add our hook to it 1979 ;; NB: `make-local-hook' needed for older/alternative Emacs compatibility 1980 ;; (make-local-hook 'post-command-hook) 1981 (add-hook 'post-command-hook 'idlwave-command-hook nil 'local) 1982 1983 ;; Make local hooks for buffer updates 1984 ;; NB: `make-local-hook' needed for older/alternative Emacs compatibility 1985 ;; (make-local-hook 'kill-buffer-hook) 1986 (add-hook 'kill-buffer-hook 'idlwave-kill-buffer-update nil 'local) 1987 ;; (make-local-hook 'after-save-hook) 1988 (add-hook 'after-save-hook 'idlwave-save-buffer-update nil 'local) 1989 (add-hook 'after-save-hook 'idlwave-revoke-license-to-kill nil 'local) 1990 1991 ;; Setup directories and file, if necessary 1992 (idlwave-setup) 1993 1994 ;; Update the routine info with info about current buffer? 1995 (idlwave-new-buffer-update) 1996 1997 ;; Check help location 1998 (idlwave-help-check-locations) 1999 2000 ;; Run the mode hook 2001 (run-mode-hooks 'idlwave-mode-hook)) 2002 2003(defvar idlwave-setup-done nil) 2004(defun idlwave-setup () 2005 (unless idlwave-setup-done 2006 (if (not (file-directory-p idlwave-config-directory)) 2007 (make-directory idlwave-config-directory)) 2008 (setq 2009 idlwave-user-catalog-file (expand-file-name 2010 idlwave-user-catalog-file 2011 idlwave-config-directory) 2012 idlwave-xml-system-rinfo-converted-file 2013 (expand-file-name 2014 idlwave-xml-system-rinfo-converted-file 2015 idlwave-config-directory) 2016 idlwave-path-file (expand-file-name 2017 idlwave-path-file 2018 idlwave-config-directory)) 2019 (idlwave-read-paths) ; we may need these early 2020 (setq idlwave-setup-done t))) 2021 2022(defun idlwave-font-lock-fontify-region (beg end &optional verbose) 2023 "Fontify continuation lines correctly." 2024 (let (pos) 2025 (save-excursion 2026 (goto-char beg) 2027 (forward-line -1) 2028 (when (setq pos (idlwave-is-continuation-line)) 2029 (goto-char pos) 2030 (idlwave-beginning-of-statement) 2031 (setq beg (point))))) 2032 (font-lock-default-fontify-region beg end verbose)) 2033 2034;; 2035;; Code Formatting ---------------------------------------------------- 2036;; 2037 2038(defun idlwave-hard-tab () 2039 "Inserts TAB in buffer in current position." 2040 (interactive) 2041 (insert "\t")) 2042 2043;;; This stuff is experimental 2044 2045(defvar idlwave-command-hook nil 2046 "If non-nil, a list that can be evaluated using `eval'. 2047It is evaluated in the lisp function `idlwave-command-hook' which is 2048placed in `post-command-hook'.") 2049 2050(defun idlwave-command-hook () 2051 "Command run after every command. 2052Evaluates a non-nil value of the *variable* `idlwave-command-hook' and 2053sets the variable to zero afterwards." 2054 (and idlwave-command-hook 2055 (listp idlwave-command-hook) 2056 (condition-case nil 2057 (eval idlwave-command-hook) 2058 (error nil))) 2059 (setq idlwave-command-hook nil)) 2060 2061;;; End experiment 2062 2063;; It would be better to use expand.el for better abbrev handling and 2064;; versatility. 2065 2066(defun idlwave-check-abbrev (arg &optional reserved) 2067 "Reverses abbrev expansion if in comment or string. 2068Argument ARG is the number of characters to move point 2069backward if `idlwave-abbrev-move' is non-nil. 2070If optional argument RESERVED is non-nil then the expansion 2071consists of reserved words, which will be capitalized if 2072`idlwave-reserved-word-upcase' is non-nil. 2073Otherwise, the abbrev will be capitalized if `idlwave-abbrev-change-case' 2074is non-nil, unless its value is \`down in which case the abbrev will be 2075made into all lowercase. 2076Returns non-nil if abbrev is left expanded." 2077 (if (idlwave-quoted) 2078 (progn (unexpand-abbrev) 2079 nil) 2080 (if (and reserved idlwave-reserved-word-upcase) 2081 (upcase-region last-abbrev-location (point)) 2082 (cond 2083 ((equal idlwave-abbrev-change-case 'down) 2084 (downcase-region last-abbrev-location (point))) 2085 (idlwave-abbrev-change-case 2086 (upcase-region last-abbrev-location (point))))) 2087 (if (and idlwave-abbrev-move (> arg 0)) 2088 (if (boundp 'post-command-hook) 2089 (setq idlwave-command-hook (list 'backward-char (1+ arg))) 2090 (backward-char arg))) 2091 t)) 2092 2093(defun idlwave-in-comment () 2094 "Returns t if point is inside a comment, nil otherwise." 2095 (save-excursion 2096 (let ((here (point))) 2097 (and (idlwave-goto-comment) (> here (point)))))) 2098 2099(defun idlwave-goto-comment () 2100 "Move to start of comment delimiter on current line. 2101Moves to end of line if there is no comment delimiter. 2102Ignores comment delimiters in strings. 2103Returns point if comment found and nil otherwise." 2104 (let ((eos (progn (end-of-line) (point))) 2105 (data (match-data)) 2106 found) 2107 ;; Look for first comment delimiter not in a string 2108 (beginning-of-line) 2109 (setq found (search-forward comment-start eos 'lim)) 2110 (while (and found (idlwave-in-quote)) 2111 (setq found (search-forward comment-start eos 'lim))) 2112 (store-match-data data) 2113 (and found (not (idlwave-in-quote)) 2114 (progn 2115 (backward-char 1) 2116 (point))))) 2117 2118(defvar transient-mark-mode) 2119(defvar zmacs-regions) 2120(defvar mark-active) 2121(defun idlwave-region-active-p () 2122 "Is transient-mark-mode on and the region active? 2123Works on both Emacs and XEmacs." 2124 (if (featurep 'xemacs) 2125 (and zmacs-regions (region-active-p)) 2126 (and transient-mark-mode mark-active))) 2127 2128(defun idlwave-show-matching-quote () 2129 "Insert quote and show matching quote if this is end of a string." 2130 (interactive) 2131 (let ((bq (idlwave-in-quote)) 2132 (inq last-command-char)) 2133 (if (and bq (not (idlwave-in-comment))) 2134 (let ((delim (char-after bq))) 2135 (insert inq) 2136 (if (eq inq delim) 2137 (save-excursion 2138 (goto-char bq) 2139 (sit-for 1)))) 2140 ;; Not the end of a string 2141 (insert inq)))) 2142 2143(defun idlwave-show-begin-check () 2144 "Ensure that the previous word was a token before `idlwave-show-begin'. 2145An END token must be preceded by whitespace." 2146 (if (not (idlwave-quoted)) 2147 (if 2148 (save-excursion 2149 (backward-word 1) 2150 (backward-char 1) 2151 (looking-at "[ \t\n\f]")) 2152 (idlwave-show-begin)))) 2153 2154(defun idlwave-show-begin () 2155 "Finds the start of current block and blinks to it for a second. 2156Also checks if the correct end statement has been used." 2157 ;; All end statements are reserved words 2158 ;; Re-indent end line 2159 ;;(insert-char ?\ 1) ;; So indent, etc. work well 2160 ;;(backward-char 1) 2161 (let* ((pos (point-marker)) 2162 (last-abbrev-marker (copy-marker last-abbrev-location)) 2163 (eol-pos (save-excursion (end-of-line) (point))) 2164 begin-pos end-pos end end1 ) 2165 (if idlwave-reindent-end (idlwave-indent-line)) 2166 (setq last-abbrev-location (marker-position last-abbrev-marker)) 2167 (when (and (idlwave-check-abbrev 0 t) 2168 idlwave-show-block) 2169 (save-excursion 2170 ;; Move inside current block 2171 (goto-char last-abbrev-marker) 2172 (idlwave-block-jump-out -1 'nomark) 2173 (setq begin-pos (point)) 2174 (idlwave-block-jump-out 1 'nomark) 2175 (setq end-pos (point)) 2176 (if (> end-pos eol-pos) 2177 (setq end-pos pos)) 2178 (goto-char end-pos) 2179 (setq end (buffer-substring 2180 (progn 2181 (skip-chars-backward "a-zA-Z") 2182 (point)) 2183 end-pos)) 2184 (goto-char begin-pos) 2185 (when (setq end1 (cdr (idlwave-block-master))) 2186 (cond 2187 ((null end1)) ; no-operation 2188 ((string= (downcase end) (downcase end1)) 2189 (sit-for 1)) 2190 ((string= (downcase end) "end") 2191 ;; A generic end 2192 (if idlwave-expand-generic-end 2193 (save-excursion 2194 (goto-char pos) 2195 (backward-char 3) 2196 (insert (if (string= end "END") (upcase end1) end1)) 2197 (delete-char 3))) 2198 (sit-for 1)) 2199 (t 2200 (beep) 2201 (message "Warning: Shouldn't this be \"%s\" instead of \"%s\"?" 2202 end1 end) 2203 (sit-for 1)))))))) 2204 ;;(delete-char 1)) 2205 2206(defun idlwave-block-master () 2207 (let ((case-fold-search t)) 2208 (save-excursion 2209 (cond 2210 ((looking-at "pro\\|case\\|switch\\|function\\>") 2211 (assoc (downcase (match-string 0)) idlwave-block-matches)) 2212 ((looking-at "begin\\>") 2213 (let ((limit (save-excursion 2214 (idlwave-beginning-of-statement) 2215 (point)))) 2216 (cond 2217 ((re-search-backward ":[ \t]*\\=" limit t) 2218 ;; seems to be a case thing 2219 '("begin" . "end")) 2220 ((re-search-backward idlwave-block-match-regexp limit t) 2221 (assoc (downcase (match-string 1)) 2222 idlwave-block-matches)) 2223 (t 2224 ;; Just a normal block 2225 '("begin" . "end"))))) 2226 (t nil))))) 2227 2228(defun idlwave-close-block () 2229 "Terminate the current block with the correct END statement." 2230 (interactive) 2231 ;; Start new line if we are not in a new line 2232 (unless (save-excursion 2233 (skip-chars-backward " \t") 2234 (bolp)) 2235 (let ((idlwave-show-block nil)) 2236 (newline-and-indent))) 2237 (let ((last-abbrev-location (point))) ; for upcasing 2238 (insert "end") 2239 (idlwave-show-begin))) 2240 2241(defun idlwave-custom-ampersand-surround (&optional is-action) 2242 "Surround &, leaving room for && (which surrround as well)." 2243 (let* ((prev-char (char-after (- (point) 2))) 2244 (next-char (char-after (point))) 2245 (amp-left (eq prev-char ?&)) 2246 (amp-right (eq next-char ?&)) 2247 (len (if amp-left 2 1))) 2248 (unless amp-right ;no need to do it twice, amp-left will catch it. 2249 (idlwave-surround -1 (if (or is-action amp-left) -1) len)))) 2250 2251(defun idlwave-custom-ltgtr-surround (gtr &optional is-action) 2252 "Surround > and < by blanks, leaving room for >= and <=, and considering ->." 2253 (let* ((prev-char (char-after (- (point) 2))) 2254 (next-char (char-after (point))) 2255 (method-invoke (and gtr (eq prev-char ?-))) 2256 (len (if method-invoke 2 1))) 2257 (unless (eq next-char ?=) 2258 ;; Key binding: pad only on left, to save for possible >=/<= 2259 (idlwave-surround -1 (if (or is-action method-invoke) -1) len)))) 2260 2261(defun idlwave-surround (&optional before after length is-action) 2262 "Surround the LENGTH characters before point with blanks. 2263LENGTH defaults to 1. 2264Optional arguments BEFORE and AFTER affect the behavior before and 2265after the characters (see also description of `idlwave-make-space'): 2266 2267nil do nothing 22680 force no spaces 2269integer > 0 force exactly n spaces 2270integer < 0 at least |n| spaces 2271 2272The function does nothing if any of the following conditions is true: 2273- `idlwave-surround-by-blank' is nil 2274- the character before point is inside a string or comment" 2275 (when (and idlwave-surround-by-blank (not (idlwave-quoted))) 2276 (let ((length (or length 1))) ; establish a default for LENGTH 2277 (backward-char length) 2278 (save-restriction 2279 (let ((here (point))) 2280 (skip-chars-backward " \t") 2281 (if (bolp) 2282 ;; avoid clobbering indent 2283 (progn 2284 (move-to-column (idlwave-calculate-indent)) 2285 (if (<= (point) here) 2286 (narrow-to-region (point) here)) 2287 (goto-char here))) 2288 (idlwave-make-space before)) 2289 (skip-chars-forward " \t")) 2290 (forward-char length) 2291 (idlwave-make-space after) 2292 ;; Check to see if the line should auto wrap 2293 (if (and (equal (char-after (1- (point))) ?\ ) 2294 (> (current-column) fill-column)) 2295 (funcall auto-fill-function))))) 2296 2297(defun idlwave-make-space (n) 2298 "Make space at point. 2299The space affected is all the spaces and tabs around point. 2300If n is non-nil then point is left abs(n) spaces from the beginning of 2301the contiguous space. 2302The amount of space at point is determined by N. 2303If the value of N is: 2304nil - do nothing. 2305> 0 - exactly N spaces. 2306< 0 - a minimum of -N spaces, i.e., do not change if there are 2307 already -N spaces. 23080 - no spaces (i.e. remove any existing space)." 2309 (if (integerp n) 2310 (let 2311 ((start-col (progn (skip-chars-backward " \t") (current-column))) 2312 (left (point)) 2313 (end-col (progn (skip-chars-forward " \t") (current-column)))) 2314 (delete-horizontal-space) 2315 (cond 2316 ((> n 0) 2317 (idlwave-indent-to (+ start-col n)) 2318 (goto-char (+ left n))) 2319 ((< n 0) 2320 (idlwave-indent-to end-col (- n)) 2321 (goto-char (- left n))) 2322 ;; n = 0, done 2323 )))) 2324 2325(defun idlwave-newline () 2326 "Inserts a newline and indents the current and previous line." 2327 (interactive) 2328 ;; 2329 ;; Handle unterminated single and double quotes 2330 ;; If not in a comment and in a string then insertion of a newline 2331 ;; will mean unbalanced quotes. 2332 ;; 2333 (if (and (not (idlwave-in-comment)) (idlwave-in-quote)) 2334 (progn (beep) 2335 (message "Warning: unbalanced quotes?"))) 2336 (newline) 2337 ;; 2338 ;; The current line is being split, the cursor should be at the 2339 ;; beginning of the new line skipping the leading indentation. 2340 ;; 2341 ;; The reason we insert the new line before indenting is that the 2342 ;; indenting could be confused by keywords (e.g. END) on the line 2343 ;; after the split point. This prevents us from just using 2344 ;; `indent-for-tab-command' followed by `newline-and-indent'. 2345 ;; 2346 (beginning-of-line 0) 2347 (idlwave-indent-line) 2348 (forward-line) 2349 (idlwave-indent-line)) 2350 2351;; 2352;; Use global variable 'comment-column' to set parallel comment 2353;; 2354;; Modeled on lisp.el 2355;; Emacs Lisp and IDL (Wave CL) have identical comment syntax 2356(defun idlwave-comment-hook () 2357 "Compute indent for the beginning of the IDL comment delimiter." 2358 (if (or (looking-at idlwave-no-change-comment) 2359 (if idlwave-begin-line-comment 2360 (looking-at idlwave-begin-line-comment) 2361 (looking-at "^;"))) 2362 (current-column) 2363 (if (looking-at idlwave-code-comment) 2364 (if (save-excursion (skip-chars-backward " \t") (bolp)) 2365 ;; On line by itself, indent as code 2366 (let ((tem (idlwave-calculate-indent))) 2367 (if (listp tem) (car tem) tem)) 2368 ;; after code - do not change 2369 (current-column)) 2370 (skip-chars-backward " \t") 2371 (max (if (bolp) 0 (1+ (current-column))) 2372 comment-column)))) 2373 2374(defun idlwave-split-line () 2375 "Continue line by breaking line at point and indent the lines. 2376For a code line insert continuation marker. If the line is a line comment 2377then the new line will contain a comment with the same indentation. 2378Splits strings with the IDL operator `+' if `idlwave-split-line-string' is 2379non-nil." 2380 (interactive) 2381 ;; Expand abbreviation, just like normal RET would. 2382 (and abbrev-mode (expand-abbrev)) 2383 (let (beg) 2384 (if (not (idlwave-in-comment)) 2385 ;; For code line add continuation. 2386 ;; Check if splitting a string. 2387 (progn 2388 (if (setq beg (idlwave-in-quote)) 2389 (if idlwave-split-line-string 2390 ;; Split the string. 2391 (progn (insert (setq beg (char-after beg)) " + " 2392 idlwave-continuation-char beg) 2393 (backward-char 1) 2394 (newline-and-indent) 2395 (forward-char 1)) 2396 ;; Do not split the string. 2397 (beep) 2398 (message "Warning: continuation inside string!!") 2399 (insert " " idlwave-continuation-char)) 2400 ;; Not splitting a string. 2401 (if (not (member (char-before) '(?\ ?\t))) 2402 (insert " ")) 2403 (insert idlwave-continuation-char) 2404 (newline-and-indent))) 2405 (indent-new-comment-line)) 2406 ;; Indent previous line 2407 (setq beg (- (point-max) (point))) 2408 (forward-line -1) 2409 (idlwave-indent-line) 2410 (goto-char (- (point-max) beg)) 2411 ;; Reindent new line 2412 (idlwave-indent-line))) 2413 2414(defun idlwave-beginning-of-subprogram (&optional nomark) 2415 "Moves point to the beginning of the current program unit. 2416If NOMARK is non-nil, do not push mark." 2417 (interactive) 2418 (idlwave-find-key idlwave-begin-unit-reg -1 nomark)) 2419 2420(defun idlwave-end-of-subprogram (&optional nomark) 2421 "Moves point to the start of the next program unit. 2422If NOMARK is non-nil, do not push mark." 2423 (interactive) 2424 (idlwave-end-of-statement) 2425 (idlwave-find-key idlwave-end-unit-reg 1 nomark)) 2426 2427(defun idlwave-mark-statement () 2428 "Mark current IDL statement." 2429 (interactive) 2430 (idlwave-end-of-statement) 2431 (let ((end (point))) 2432 (idlwave-beginning-of-statement) 2433 (push-mark end nil t))) 2434 2435(defun idlwave-mark-block () 2436 "Mark containing block." 2437 (interactive) 2438 (idlwave-end-of-statement) 2439 (idlwave-backward-up-block -1) 2440 (idlwave-end-of-statement) 2441 (let ((end (point))) 2442 (idlwave-backward-block) 2443 (idlwave-beginning-of-statement) 2444 (push-mark end nil t))) 2445 2446 2447(defun idlwave-mark-subprogram () 2448 "Put mark at beginning of program, point at end. 2449The marks are pushed." 2450 (interactive) 2451 (idlwave-end-of-statement) 2452 (idlwave-beginning-of-subprogram) 2453 (let ((beg (point))) 2454 (idlwave-forward-block) 2455 (push-mark beg nil t)) 2456 (exchange-point-and-mark)) 2457 2458(defun idlwave-backward-up-block (&optional arg) 2459 "Move to beginning of enclosing block if prefix ARG >= 0. 2460If prefix ARG < 0 then move forward to enclosing block end." 2461 (interactive "p") 2462 (idlwave-block-jump-out (- arg) 'nomark)) 2463 2464(defun idlwave-beginning-of-block () 2465 "Go to the beginning of the current block." 2466 (interactive) 2467 (idlwave-block-jump-out -1 'nomark) 2468 (forward-word 1)) 2469 2470(defun idlwave-end-of-block () 2471 "Go to the beginning of the current block." 2472 (interactive) 2473 (idlwave-block-jump-out 1 'nomark) 2474 (backward-word 1)) 2475 2476(defun idlwave-forward-block (&optional arg) 2477 "Move across next nested block." 2478 (interactive) 2479 (let ((arg (or arg 1))) 2480 (if (idlwave-down-block arg) 2481 (idlwave-block-jump-out arg 'nomark)))) 2482 2483(defun idlwave-backward-block () 2484 "Move backward across previous nested block." 2485 (interactive) 2486 (if (idlwave-down-block -1) 2487 (idlwave-block-jump-out -1 'nomark))) 2488 2489(defun idlwave-down-block (&optional arg) 2490 "Go down a block. 2491With ARG: ARG >= 0 go forwards, ARG < 0 go backwards. 2492Returns non-nil if successfull." 2493 (interactive "p") 2494 (let (status) 2495 (if (< arg 0) 2496 ;; Backward 2497 (let ((eos (save-excursion 2498 (idlwave-block-jump-out -1 'nomark) 2499 (point)))) 2500 (if (setq status (idlwave-find-key 2501 idlwave-end-block-reg -1 'nomark eos)) 2502 (idlwave-beginning-of-statement) 2503 (message "No nested block before beginning of containing block."))) 2504 ;; Forward 2505 (let ((eos (save-excursion 2506 (idlwave-block-jump-out 1 'nomark) 2507 (point)))) 2508 (if (setq status (idlwave-find-key 2509 idlwave-begin-block-reg 1 'nomark eos)) 2510 (idlwave-end-of-statement) 2511 (message "No nested block before end of containing block.")))) 2512 status)) 2513 2514(defun idlwave-mark-doclib () 2515 "Put point at beginning of doc library header, mark at end. 2516The marks are pushed." 2517 (interactive) 2518 (let (beg 2519 (here (point))) 2520 (goto-char (point-max)) 2521 (if (re-search-backward idlwave-doclib-start nil t) 2522 (progn 2523 (setq beg (progn (beginning-of-line) (point))) 2524 (if (re-search-forward idlwave-doclib-end nil t) 2525 (progn 2526 (forward-line 1) 2527 (push-mark beg nil t) 2528 (message "Could not find end of doc library header."))) 2529 (message "Could not find doc library header start.") 2530 (goto-char here))))) 2531 2532(defun idlwave-current-routine-fullname () 2533 (let ((name (idlwave-current-routine))) 2534 (idlwave-make-full-name (nth 2 name) (car name)))) 2535 2536(defun idlwave-current-routine () 2537 "Return (NAME TYPE CLASS) of current routine." 2538 (idlwave-routines) 2539 (save-excursion 2540 (idlwave-beginning-of-subprogram 'nomark) 2541 (if (looking-at "[ \t]*\\<\\(pro\\|function\\)\\>\\s-+\\(\\([a-zA-Z0-9$_]+\\)::\\)?\\([a-zA-Z0-9$_]+\\)") 2542 (let* ((type (if (string= (downcase (match-string 1)) "pro") 2543 'pro 'function)) 2544 (class (idlwave-sintern-class (match-string 3))) 2545 (name (idlwave-sintern-routine-or-method (match-string 4) class))) 2546 (list name type class))))) 2547 2548(defvar idlwave-shell-prompt-pattern) 2549(defun idlwave-beginning-of-statement () 2550 "Move to beginning of the current statement. 2551Skips back past statement continuations. 2552Point is placed at the beginning of the line whether or not this is an 2553actual statement." 2554 (interactive) 2555 (cond 2556 ((eq major-mode 'idlwave-shell-mode) 2557 (if (re-search-backward idlwave-shell-prompt-pattern nil t) 2558 (goto-char (match-end 0)))) 2559 (t 2560 (if (save-excursion (forward-line -1) (idlwave-is-continuation-line)) 2561 (idlwave-previous-statement) 2562 (beginning-of-line))))) 2563 2564(defun idlwave-previous-statement () 2565 "Moves point to beginning of the previous statement. 2566Returns t if the current line before moving is the beginning of 2567the first non-comment statement in the file, and nil otherwise." 2568 (interactive) 2569 (let (first-statement) 2570 (if (not (= (forward-line -1) 0)) 2571 ;; first line in file 2572 t 2573 ;; skip blank lines, label lines, include lines and line comments 2574 (while (and 2575 ;; The current statement is the first statement until we 2576 ;; reach another statement. 2577 (setq first-statement 2578 (or 2579 (looking-at idlwave-comment-line-start-skip) 2580 (looking-at "[ \t]*$") 2581 (looking-at (concat "[ \t]*" idlwave-label "[ \t]*$")) 2582 (looking-at "^@"))) 2583 (= (forward-line -1) 0))) 2584 ;; skip continuation lines 2585 (while (and 2586 (save-excursion 2587 (forward-line -1) 2588 (idlwave-is-continuation-line)) 2589 (= (forward-line -1) 0))) 2590 first-statement))) 2591 2592(defun idlwave-end-of-statement () 2593 "Moves point to the end of the current IDL statement. 2594If not in a statement just moves to end of line. Returns position." 2595 (interactive) 2596 (while (and (idlwave-is-continuation-line) 2597 (= (forward-line 1) 0)) 2598 (while (and (idlwave-is-comment-or-empty-line) 2599 (= (forward-line 1) 0)))) 2600 (end-of-line) 2601 (point)) 2602 2603(defun idlwave-end-of-statement0 () 2604 "Moves point to the end of the current IDL statement. 2605If not in a statement just moves to end of line. Returns position." 2606 (interactive) 2607 (while (and (idlwave-is-continuation-line) 2608 (= (forward-line 1) 0))) 2609 (end-of-line) 2610 (point)) 2611 2612(defun idlwave-next-statement () 2613 "Moves point to beginning of the next IDL statement. 2614 Returns t if that statement is the last 2615 non-comment IDL statement in the file, and nil otherwise." 2616 (interactive) 2617 (let (last-statement) 2618 (idlwave-end-of-statement) 2619 ;; skip blank lines, label lines, include lines and line comments 2620 (while (and (= (forward-line 1) 0) 2621 ;; The current statement is the last statement until 2622 ;; we reach a new statement. 2623 (setq last-statement 2624 (or 2625 (looking-at idlwave-comment-line-start-skip) 2626 (looking-at "[ \t]*$") 2627 (looking-at (concat "[ \t]*" idlwave-label "[ \t]*$")) 2628 (looking-at "^@"))))) 2629 last-statement)) 2630 2631(defun idlwave-skip-multi-commands (&optional lim) 2632 "Skip past multiple commands on a line (with `&')." 2633 (let ((save-point (point))) 2634 (when (re-search-forward ".*&" lim t) 2635 (goto-char (match-end 0)) 2636 (if (idlwave-quoted) 2637 (goto-char save-point) 2638 (if (eq (char-after (- (point) 2)) ?&) (goto-char save-point)))) 2639 (point))) 2640 2641(defun idlwave-skip-label-or-case () 2642 "Skip label or case statement element. 2643Returns position after label. 2644If there is no label point is not moved and nil is returned." 2645 ;; Case expressions and labels are terminated by a colon. 2646 ;; So we find the first colon in the line and make sure 2647 ;; - no `?' is before it (might be a ? b : c) 2648 ;; - it is not in a comment 2649 ;; - not in a string constant 2650 ;; - not in parenthesis (like a[0:3]) 2651 ;; - not followed by another ":" in explicit class, ala a->b::c 2652 ;; As many in this mode, this function is heuristic and not an exact 2653 ;; parser. 2654 (let* ((start (point)) 2655 (eos (save-excursion (idlwave-end-of-statement) (point))) 2656 (end (idlwave-find-key ":" 1 'nomark eos))) 2657 (if (and end 2658 (= (nth 0 (parse-partial-sexp start end)) 0) 2659 (not (string-match "\\?" (buffer-substring start end))) 2660 (not (string-match "^::" (buffer-substring end eos)))) 2661 (progn 2662 (forward-char) 2663 (point)) 2664 (goto-char start) 2665 nil))) 2666 2667(defun idlwave-start-of-substatement (&optional pre) 2668 "Move to start of next IDL substatement after point. 2669Uses the type of the current IDL statement to determine if the next 2670statement is on a new line or is a subpart of the current statement. 2671Returns point at start of substatement modulo whitespace. 2672If optional argument is non-nil move to beginning of current 2673substatement." 2674 (let ((orig (point)) 2675 (eos (idlwave-end-of-statement)) 2676 (ifnest 0) 2677 st nst last) 2678 (idlwave-beginning-of-statement) 2679 (idlwave-skip-label-or-case) 2680 (if (< (point) orig) 2681 (idlwave-skip-multi-commands orig)) 2682 (setq last (point)) 2683 ;; Continue looking for substatements until we are past orig 2684 (while (and (<= (point) orig) (not (eobp))) 2685 (setq last (point)) 2686 (setq nst (nth 1 (cdr (setq st (car (idlwave-statement-type)))))) 2687 (if (equal (car st) 'if) (setq ifnest (1+ ifnest))) 2688 (cond ((and nst 2689 (idlwave-find-key nst 1 'nomark eos)) 2690 (goto-char (match-end 0))) 2691 ((and (> ifnest 0) (idlwave-find-key "\\<else\\>" 1 'nomark eos)) 2692 (setq ifnest (1- ifnest)) 2693 (goto-char (match-end 0))) 2694 (t (setq ifnest 0) 2695 (idlwave-next-statement)))) 2696 (if pre (goto-char last)) 2697 ;; If a continuation line starts here, move to next line 2698 (if (looking-at "[ \t]*\\$\\([ \t]*\\(;\\|$\\)\\)") 2699 (beginning-of-line 2)) 2700 (point))) 2701 2702(defun idlwave-statement-type () 2703 "Return the type of the current IDL statement. 2704Uses `idlwave-statement-match' to return a cons of (type . point) with 2705point the ending position where the type was determined. Type is the 2706association from `idlwave-statement-match', i.e. the cons cell from the 2707list not just the type symbol. Returns nil if not an identifiable 2708statement." 2709 (save-excursion 2710 ;; Skip whitespace within a statement which is spaces, tabs, continuations 2711 ;; and possibly comments 2712 (while (looking-at "[ \t]*\\$") 2713 (forward-line 1)) 2714 (skip-chars-forward " \t") 2715 (let ((st idlwave-statement-match) 2716 (case-fold-search t)) 2717 (while (and (not (looking-at (nth 0 (cdr (car st))))) 2718 (setq st (cdr st)))) 2719 (if st 2720 (append st (match-end 0)))))) 2721 2722(defun idlwave-expand-equal (&optional before after is-action) 2723 "Pad '=' with spaces. Two cases: Assignment statement, and keyword 2724assignment. Which case is determined using 2725`idlwave-start-of-substatement' and `idlwave-statement-type'. The 2726equal sign will be surrounded by BEFORE and AFTER blanks. If 2727`idlwave-pad-keyword' is t then keyword assignment is treated just 2728like assignment statements. When nil, spaces are removed for keyword 2729assignment. Any other value keeps the current space around the `='. 2730Limits in for loops are treated as keyword assignment. 2731 2732Starting with IDL 6.0, a number of op= assignments are available. 2733Since ambiguities of the form: 2734 2735r and= b 2736rand= b 2737 2738can occur, alphanumeric operator assignment will never be pre-padded, 2739only post-padded. You must use a space before these to disambiguate 2740\(not just for padding, but for proper parsing by IDL too!). Other 2741operators, such as ##=, ^=, etc., will be pre-padded. 2742 2743IS-ACTION is ignored. 2744 2745See `idlwave-surround'." 2746 (if idlwave-surround-by-blank 2747 (let 2748 ((non-an-ops "\\(##\\|\\*\\|\\+\\|-\\|/\\|<\\|>\\|\\^\\)\\=") 2749 (an-ops 2750 "\\s-\\(AND\\|EQ\\|GE\\|GT\\|LE\\|LT\\|MOD\\|NE\\|OR\\|XOR\\)\\=") 2751 (len 1)) 2752 2753 (save-excursion 2754 (let ((case-fold-search t)) 2755 (backward-char) 2756 (if (or 2757 (re-search-backward non-an-ops nil t) 2758 ;; Why doesn't ##? work for both? 2759 (re-search-backward "\\(#\\)\\=" nil t)) 2760 (setq len (1+ (length (match-string 1)))) 2761 (when (re-search-backward an-ops nil t) 2762 ;(setq begin nil) ; won't modify begin 2763 (setq len (1+ (length (match-string 1)))))))) 2764 2765 (if (eq t idlwave-pad-keyword) 2766 ;; Everything gets padded equally 2767 (idlwave-surround before after len) 2768 ;; Treating keywords/for variables specially... 2769 (let ((st (save-excursion ; To catch "for" variables 2770 (idlwave-start-of-substatement t) 2771 (idlwave-statement-type))) 2772 (what (save-excursion ; To catch keywords 2773 (skip-chars-backward "= \t") 2774 (nth 2 (idlwave-where))))) 2775 (cond ((or (memq what '(function-keyword procedure-keyword)) 2776 (memq (caar st) '(for pdef))) 2777 (cond 2778 ((null idlwave-pad-keyword) 2779 (idlwave-surround 0 0) 2780 ) ; remove space 2781 (t))) ; leave any spaces alone 2782 (t (idlwave-surround before after len)))))))) 2783 2784 2785(defun idlwave-indent-and-action (&optional arg) 2786 "Call `idlwave-indent-line' and do expand actions. 2787With prefix ARG non-nil, indent the entire sub-statement." 2788 (interactive "p") 2789 (save-excursion 2790 (if (and idlwave-expand-generic-end 2791 (re-search-backward "\\<\\(end\\)\\s-*\\=" 2792 (max 0 (- (point) 10)) t) 2793 (looking-at "\\(end\\)\\([ \n\t]\\|\\'\\)")) 2794 (progn (goto-char (match-end 1)) 2795 ;;Expand the END abbreviation, just as RET or Space would have. 2796 (if abbrev-mode (expand-abbrev) 2797 (idlwave-show-begin))))) 2798 (when (and (not arg) current-prefix-arg) 2799 (setq arg current-prefix-arg) 2800 (setq current-prefix-arg nil)) 2801 (if arg 2802 (idlwave-indent-statement) 2803 (idlwave-indent-line t))) 2804 2805(defun idlwave-indent-line (&optional expand) 2806 "Indents current IDL line as code or as a comment. 2807The actions in `idlwave-indent-action-table' are performed. 2808If the optional argument EXPAND is non-nil then the actions in 2809`idlwave-indent-expand-table' are performed." 2810 (interactive) 2811 ;; Move point out of left margin. 2812 (if (save-excursion 2813 (skip-chars-backward " \t") 2814 (bolp)) 2815 (skip-chars-forward " \t")) 2816 (let ((mloc (point-marker))) 2817 (save-excursion 2818 (beginning-of-line) 2819 (if (looking-at idlwave-comment-line-start-skip) 2820 ;; Indentation for a line comment 2821 (progn 2822 (skip-chars-forward " \t") 2823 (idlwave-indent-left-margin (idlwave-comment-hook))) 2824 ;; 2825 ;; Code Line 2826 ;; 2827 ;; Before indenting, run action routines. 2828 ;; 2829 (if (and expand idlwave-do-actions) 2830 (mapcar 'idlwave-do-action idlwave-indent-expand-table)) 2831 ;; 2832 (if idlwave-do-actions 2833 (mapcar 'idlwave-do-action idlwave-indent-action-table)) 2834 ;; 2835 ;; No longer expand abbrevs on the line. The user can do this 2836 ;; manually using expand-region-abbrevs. 2837 ;; 2838 ;; Indent for code line 2839 ;; 2840 (beginning-of-line) 2841 (if (or 2842 ;; a label line 2843 (looking-at (concat "^" idlwave-label "[ \t]*$")) 2844 ;; a batch command 2845 (looking-at "^[ \t]*@")) 2846 ;; leave flush left 2847 nil 2848 ;; indent the line 2849 (idlwave-indent-left-margin (idlwave-calculate-indent))) 2850 ;; Adjust parallel comment 2851 (end-of-line) 2852 (if (idlwave-in-comment) 2853 ;; Emacs 21 is too smart with fill-column on comment indent 2854 (let ((fill-column (if (fboundp 'comment-indent-new-line) 2855 (1- (frame-width)) 2856 fill-column))) 2857 (indent-for-comment))))) 2858 (goto-char mloc) 2859 ;; Get rid of marker 2860 (set-marker mloc nil))) 2861 2862(defun idlwave-do-action (action) 2863 "Perform an action repeatedly on a line. ACTION is a list (REG 2864. FUNC). REG is a regular expression. FUNC is either a function name 2865to be called with `funcall' or a list to be evaluated with `eval'. 2866The action performed by FUNC should leave point after the match for 2867REG - otherwise an infinite loop may be entered. FUNC is always 2868passed a final argument of 'is-action, so it can discriminate between 2869being run as an action, or a key binding" 2870 (let ((action-key (car action)) 2871 (action-routine (cdr action))) 2872 (beginning-of-line) 2873 (while (idlwave-look-at action-key) 2874 (if (listp action-routine) 2875 (eval (append action-routine '('is-action))) 2876 (funcall action-routine 'is-action))))) 2877 2878(defun idlwave-indent-to (col &optional min) 2879 "Indent from point with spaces until column COL. 2880Inserts space before markers at point." 2881 (if (not min) (setq min 0)) 2882 (insert-before-markers 2883 (make-string (max min (- col (current-column))) ?\ ))) 2884 2885(defun idlwave-indent-left-margin (col) 2886 "Indent the current line to column COL. 2887Indents such that first non-whitespace character is at column COL 2888Inserts spaces before markers at point." 2889 (save-excursion 2890 (beginning-of-line) 2891 (delete-horizontal-space) 2892 (idlwave-indent-to col))) 2893 2894(defun idlwave-indent-subprogram () 2895 "Indents program unit which contains point." 2896 (interactive) 2897 (save-excursion 2898 (idlwave-end-of-statement) 2899 (idlwave-beginning-of-subprogram) 2900 (let ((beg (point))) 2901 (idlwave-forward-block) 2902 (message "Indenting subprogram...") 2903 (indent-region beg (point) nil)) 2904 (message "Indenting subprogram...done."))) 2905 2906(defun idlwave-indent-statement () 2907 "Indent current statement, including all continuation lines." 2908 (interactive) 2909 (save-excursion 2910 (idlwave-beginning-of-statement) 2911 (let ((beg (point))) 2912 (idlwave-end-of-statement) 2913 (indent-region beg (point) nil)))) 2914 2915(defun idlwave-calculate-indent () 2916 "Return appropriate indentation for current line as IDL code." 2917 (save-excursion 2918 (beginning-of-line) 2919 (cond 2920 ;; Check for beginning of unit - main (beginning of buffer), pro, or 2921 ;; function 2922 ((idlwave-look-at idlwave-begin-unit-reg) 2923 0) 2924 ;; Check for continuation line 2925 ((save-excursion 2926 (and (= (forward-line -1) 0) 2927 (idlwave-is-continuation-line))) 2928 (idlwave-calculate-cont-indent)) 2929 ;; calculate indent based on previous and current statements 2930 (t (let* (beg-prev-pos 2931 (the-indent 2932 ;; calculate indent based on previous statement 2933 (save-excursion 2934 (cond 2935 ;; Beginning of file 2936 ((prog1 2937 (idlwave-previous-statement) 2938 (setq beg-prev-pos (point))) 2939 0) 2940 ;; Main block 2941 ((idlwave-look-at idlwave-begin-unit-reg t) 2942 (+ (idlwave-current-statement-indent) 2943 idlwave-main-block-indent)) 2944 ;; Begin block 2945 ((idlwave-look-at idlwave-begin-block-reg t) 2946 (+ (idlwave-min-current-statement-indent) 2947 idlwave-block-indent)) 2948 ;; End Block 2949 ((idlwave-look-at idlwave-end-block-reg t) 2950 (progn 2951 ;; Match to the *beginning* of the block opener 2952 (goto-char beg-prev-pos) 2953 (idlwave-block-jump-out -1 'nomark) ; go to begin block 2954 (idlwave-min-current-statement-indent))) 2955 ;; idlwave-end-offset 2956 ;; idlwave-block-indent)) 2957 2958 ;; Default to current indent 2959 ((idlwave-current-statement-indent)))))) 2960 ;; adjust the indentation based on the current statement 2961 (cond 2962 ;; End block 2963 ((idlwave-look-at idlwave-end-block-reg) 2964 (+ the-indent idlwave-end-offset)) 2965 (the-indent))))))) 2966 2967;; 2968;; Parentheses indent 2969;; 2970 2971(defun idlwave-calculate-paren-indent (beg-reg end-reg close-exp) 2972 "Calculate the continuation indent inside a paren group. 2973Returns a cons-cell with (open . indent), where open is the 2974location of the open paren" 2975 (let ((open (nth 1 (parse-partial-sexp beg-reg end-reg)))) 2976 ;; Found an innermost open paren. 2977 (when open 2978 (goto-char open) 2979 ;; Line up with next word unless this is a closing paren. 2980 (cons open 2981 (cond 2982 ;; Plain Kernighan-style nested indent 2983 (idlwave-indent-parens-nested 2984 (+ idlwave-continuation-indent (idlwave-current-indent))) 2985 2986 ;; This is a closed paren - line up under open paren. 2987 (close-exp 2988 (current-column)) 2989 2990 ;; Empty (or just comment) follows -- revert to basic indent 2991 ((progn 2992 ;; Skip paren 2993 (forward-char 1) 2994 (looking-at "[ \t$]*\\(;.*\\)?$")) 2995 nil) 2996 2997 ;; Line up with first word after any blank space 2998 ((progn 2999 (skip-chars-forward " \t") 3000 (current-column)))))))) 3001 3002(defun idlwave-calculate-cont-indent () 3003 "Calculates the IDL continuation indent column from the previous 3004statement. Note that here previous statement usually means the 3005beginning of the current statement if this statement is a continuation 3006of the previous line. Various special types of continuations, 3007including assignments, routine definitions, and parenthetical 3008groupings, are treated separately." 3009 (save-excursion 3010 (let* ((case-fold-search t) 3011 (end-reg (progn (beginning-of-line) (point))) 3012 (beg-last-statement (save-excursion (idlwave-previous-statement) 3013 (point))) 3014 (beg-reg (progn (idlwave-start-of-substatement 'pre) 3015 (if (eq (line-beginning-position) end-reg) 3016 (goto-char beg-last-statement) 3017 (point)))) 3018 (basic-indent (+ (idlwave-min-current-statement-indent end-reg) 3019 idlwave-continuation-indent)) 3020 fancy-nonparen-indent fancy-paren-indent) 3021 (cond 3022 ;; Align then with its matching if, etc. 3023 ((let ((matchers '(("\\<if\\>" . "[ \t]*then") 3024 ("\\<\\(if\\|end\\(if\\)?\\)\\>" . "[ \t]*else") 3025 ("\\<\\(for\\|while\\)\\>" . "[ \t]*do") 3026 ("\\<\\(repeat\\|end\\(rep\\)?\\)\\>" . 3027 "[ \t]*until") 3028 ("\\<case\\>" . "[ \t]*of"))) 3029 match cont-re) 3030 (goto-char end-reg) 3031 (and 3032 (setq cont-re 3033 (catch 'exit 3034 (while (setq match (car matchers)) 3035 (if (looking-at (cdr match)) 3036 (throw 'exit (car match))) 3037 (setq matchers (cdr matchers))))) 3038 (idlwave-find-key cont-re -1 'nomark beg-last-statement))) 3039 (if (looking-at "end") ;; that one's special 3040 (- (idlwave-current-indent) 3041 (+ idlwave-block-indent idlwave-end-offset)) 3042 (idlwave-current-indent))) 3043 3044 ;; Indent in from the previous line for continuing statements 3045 ((let ((matchers '("\\<then\\>" 3046 "\\<do\\>" 3047 "\\<repeat\\>" 3048 "\\<else\\>")) 3049 match) 3050 (catch 'exit 3051 (goto-char end-reg) 3052 (if (/= (forward-line -1) 0) 3053 (throw 'exit nil)) 3054 (while (setq match (car matchers)) 3055 (if (looking-at (concat ".*" match "[ \t]*\\$[ \t]*" 3056 "\\(;.*\\)?$")) 3057 (throw 'exit t)) 3058 (setq matchers (cdr matchers))))) 3059 (+ idlwave-continuation-indent (idlwave-current-indent))) 3060 3061 ;; Parenthetical indent, either traditional or Kernighan style 3062 ((setq fancy-paren-indent 3063 (let* ((end-reg end-reg) 3064 (close-exp (progn 3065 (goto-char end-reg) 3066 (skip-chars-forward " \t") 3067 (looking-at "\\s)"))) 3068 indent-cons) 3069 (catch 'loop 3070 (while (setq indent-cons (idlwave-calculate-paren-indent 3071 beg-reg end-reg close-exp)) 3072 ;; First permitted containing paren 3073 (if (or 3074 idlwave-indent-to-open-paren 3075 idlwave-indent-parens-nested 3076 (null (cdr indent-cons)) 3077 (< (- (cdr indent-cons) basic-indent) 3078 idlwave-max-extra-continuation-indent)) 3079 (throw 'loop (cdr indent-cons))) 3080 (setq end-reg (car indent-cons)))))) 3081 fancy-paren-indent) 3082 3083 ;; A continued assignment, or procedure call/definition 3084 ((and 3085 (> idlwave-max-extra-continuation-indent 0) 3086 (setq fancy-nonparen-indent 3087 (progn 3088 (goto-char beg-reg) 3089 (while (idlwave-look-at "&")) ; skip continued statements 3090 (cond 3091 ;; A continued Procedure call or definition 3092 ((progn 3093 (idlwave-look-at "^[ \t]*\\(pro\\|function\\)") ;skip over 3094 (looking-at "[ \t]*\\([a-zA-Z0-9.$_]+[ \t]*->[ \t]*\\)?[a-zA-Z][:a-zA-Z0-9$_]*[ \t]*\\(,\\)[ \t]*")) 3095 (goto-char (match-end 0)) 3096 ;; Comment only, or blank line with "$"? Basic indent. 3097 (if (save-match-data (looking-at "[ \t$]*\\(;.*\\)?$")) 3098 nil 3099 (current-column))) 3100 3101 ;; Continued assignment (with =): 3102 ((catch 'assign ; 3103 (while (looking-at "[^=\n\r]*\\(=\\)[ \t]*") 3104 (goto-char (match-end 0)) 3105 (if (null (idlwave-what-function beg-reg)) 3106 (throw 'assign t)))) 3107 (unless (or 3108 (idlwave-in-quote) 3109 (looking-at "[ \t$]*\\(;.*\\)?$") ; use basic 3110 (save-excursion 3111 (goto-char beg-last-statement) 3112 (eq (caar (idlwave-statement-type)) 'for))) 3113 (current-column)))))) 3114 (< (- fancy-nonparen-indent basic-indent) 3115 idlwave-max-extra-continuation-indent)) 3116 (if fancy-paren-indent ;calculated but disallowed paren indent 3117 (+ fancy-nonparen-indent idlwave-continuation-indent) 3118 fancy-nonparen-indent)) 3119 3120 ;; Basic indent, by default 3121 (t basic-indent))))) 3122 3123 3124 3125(defun idlwave-find-key (key-re &optional dir nomark limit) 3126 "Move to next match of the regular expression KEY-RE. 3127Matches inside comments or string constants will be ignored. 3128If DIR is negative, the search will be backwards. 3129At a successful match, the mark is pushed unless NOMARK is non-nil. 3130Searches are limited to LIMIT. 3131Searches are case-insensitive and use a special syntax table which 3132treats `$' and `_' as word characters. 3133Return value is the beginning of the match or (in case of failure) nil." 3134 (setq dir (or dir 0)) 3135 (let ((case-fold-search t) 3136 (search-func (if (> dir 0) 're-search-forward 're-search-backward)) 3137 found) 3138 (idlwave-with-special-syntax 3139 (save-excursion 3140 (catch 'exit 3141 (while (funcall search-func key-re limit t) 3142 (if (not (idlwave-quoted)) 3143 (throw 'exit (setq found (match-beginning 0))) 3144 (if (or (and (> dir 0) (eobp)) 3145 (and (< dir 0) (bobp))) 3146 (throw 'exit nil))))))) 3147 (if found 3148 (progn 3149 (if (not nomark) (push-mark)) 3150 (goto-char found) 3151 found) 3152 nil))) 3153 3154(defun idlwave-block-jump-out (&optional dir nomark) 3155 "When optional argument DIR is non-negative, move forward to end of 3156current block using the `idlwave-begin-block-reg' and `idlwave-end-block-reg' 3157regular expressions. When DIR is negative, move backwards to block beginning. 3158Recursively calls itself to skip over nested blocks. DIR defaults to 3159forward. Calls `push-mark' unless the optional argument NOMARK is 3160non-nil. Movement is limited by the start of program units because of 3161possibility of unbalanced blocks." 3162 (interactive "P") 3163 (or dir (setq dir 0)) 3164 (let* ((here (point)) 3165 (case-fold-search t) 3166 (limit (if (>= dir 0) (point-max) (point-min))) 3167 (block-limit (if (>= dir 0) 3168 idlwave-begin-block-reg 3169 idlwave-end-block-reg)) 3170 found 3171 (block-reg (concat idlwave-begin-block-reg "\\|" 3172 idlwave-end-block-reg)) 3173 (unit-limit (or (save-excursion 3174 (if (< dir 0) 3175 (idlwave-find-key 3176 idlwave-begin-unit-reg dir t limit) 3177 (end-of-line) 3178 (idlwave-find-key 3179 idlwave-end-unit-reg dir t limit))) 3180 limit))) 3181 (if (>= dir 0) (end-of-line)) ;Make sure we are in current block 3182 (if (setq found (idlwave-find-key block-reg dir t unit-limit)) 3183 (while (and found (looking-at block-limit)) 3184 (if (>= dir 0) (forward-word 1)) 3185 (idlwave-block-jump-out dir t) 3186 (setq found (idlwave-find-key block-reg dir t unit-limit)))) 3187 (if (not nomark) (push-mark here)) 3188 (if (not found) (goto-char unit-limit) 3189 (if (>= dir 0) (forward-word 1))))) 3190 3191(defun idlwave-min-current-statement-indent (&optional end-reg) 3192 "The minimum indent in the current statement." 3193 (idlwave-beginning-of-statement) 3194 (if (not (idlwave-is-continuation-line)) 3195 (idlwave-current-indent) 3196 (let ((min (idlwave-current-indent)) comm-or-empty) 3197 (while (and (= (forward-line 1) 0) 3198 (or (setq comm-or-empty (idlwave-is-comment-or-empty-line)) 3199 (idlwave-is-continuation-line)) 3200 (or (null end-reg) (< (point) end-reg))) 3201 (unless comm-or-empty (setq min (min min (idlwave-current-indent))))) 3202 (if (or comm-or-empty (and end-reg (>= (point) end-reg))) 3203 min 3204 (min min (idlwave-current-indent)))))) 3205 3206(defun idlwave-current-statement-indent (&optional last-line) 3207 "Return indentation of the current statement. 3208If in a statement, moves to beginning of statement before finding indent." 3209 (if last-line 3210 (idlwave-end-of-statement) 3211 (idlwave-beginning-of-statement)) 3212 (idlwave-current-indent)) 3213 3214(defun idlwave-current-indent () 3215 "Return the column of the indentation of the current line. 3216Skips any whitespace. Returns 0 if the end-of-line follows the whitespace." 3217 (save-excursion 3218 (beginning-of-line) 3219 (skip-chars-forward " \t") 3220 ;; if we are at the end of blank line return 0 3221 (cond ((eolp) 0) 3222 ((current-column))))) 3223 3224(defun idlwave-is-continuation-line () 3225 "Tests if current line is continuation line. 3226Blank or comment-only lines following regular continuation lines (with 3227`$') count as continuations too." 3228 (let (p) 3229 (save-excursion 3230 (or 3231 (idlwave-look-at "\\<\\$") 3232 (catch 'loop 3233 (while (and (looking-at "^[ \t]*\\(;.*\\)?$") 3234 (eq (forward-line -1) 0)) 3235 (if (setq p (idlwave-look-at "\\<\\$")) (throw 'loop p)))))))) 3236 3237(defun idlwave-is-comment-line () 3238 "Tests if the current line is a comment line." 3239 (save-excursion 3240 (beginning-of-line 1) 3241 (looking-at "[ \t]*;"))) 3242 3243(defun idlwave-is-comment-or-empty-line () 3244 "Tests if the current line is a comment line." 3245 (save-excursion 3246 (beginning-of-line 1) 3247 (looking-at "[ \t]*[;\n]"))) 3248 3249(defun idlwave-look-at (regexp &optional cont beg) 3250 "Searches current line from current point for REGEXP. 3251If optional argument CONT is non-nil, searches to the end of 3252the current statement. 3253If optional arg BEG is non-nil, search starts from the beginning of the 3254current statement. 3255Ignores matches that end in a comment or inside a string expression. 3256Returns point if successful, nil otherwise. 3257This function produces unexpected results if REGEXP contains quotes or 3258a comment delimiter. The search is case insensitive. 3259If successful leaves point after the match, otherwise, does not move point." 3260 (let ((here (point)) 3261 (case-fold-search t) 3262 (eos (save-excursion 3263 (if cont (idlwave-end-of-statement) (end-of-line)) 3264 (point))) 3265 found) 3266 (idlwave-with-special-syntax 3267 (if beg (idlwave-beginning-of-statement)) 3268 (while (and (setq found (re-search-forward regexp eos t)) 3269 (idlwave-quoted)))) 3270 (if (not found) (goto-char here)) 3271 found)) 3272 3273(defun idlwave-fill-paragraph (&optional nohang) 3274 "Fills paragraphs in comments. 3275A paragraph is made up of all contiguous lines having the same comment 3276leader (the leading whitespace before the comment delimiter and the 3277comment delimiter). In addition, paragraphs are separated by blank 3278line comments. The indentation is given by the hanging indent of the 3279first line, otherwise by the minimum indentation of the lines after 3280the first line. The indentation of the first line does not change. 3281Does not effect code lines. Does not fill comments on the same line 3282with code. The hanging indent is given by the end of the first match 3283matching `idlwave-hang-indent-regexp' on the paragraph's first line . If the 3284optional argument NOHANG is non-nil then the hanging indent is 3285ignored." 3286 (interactive "P") 3287 ;; check if this is a line comment 3288 (if (save-excursion 3289 (beginning-of-line) 3290 (skip-chars-forward " \t") 3291 (looking-at comment-start)) 3292 (let 3293 ((indent 999) 3294 pre here diff fill-prefix-reg bcl first-indent 3295 hang start end) 3296 ;; Change tabs to spaces in the surrounding paragraph. 3297 ;; The surrounding paragraph will be the largest containing block of 3298 ;; contiguous line comments. Thus, we may be changing tabs in 3299 ;; a much larger area than is needed, but this is the easiest 3300 ;; brute force way to do it. 3301 ;; 3302 ;; This has the undesirable side effect of replacing the tabs 3303 ;; permanently without the user's request or knowledge. 3304 (save-excursion 3305 (backward-paragraph) 3306 (setq start (point))) 3307 (save-excursion 3308 (forward-paragraph) 3309 (setq end (point))) 3310 (untabify start end) 3311 ;; 3312 (setq here (point)) 3313 (beginning-of-line) 3314 (setq bcl (point)) 3315 (re-search-forward 3316 (concat "^[ \t]*" comment-start "+") 3317 (save-excursion (end-of-line) (point)) 3318 t) 3319 ;; Get the comment leader on the line and its length 3320 (setq pre (current-column)) 3321 ;; the comment leader is the indentation plus exactly the 3322 ;; number of consecutive ";". 3323 (setq fill-prefix-reg 3324 (concat 3325 (setq fill-prefix 3326 (regexp-quote 3327 (buffer-substring (save-excursion 3328 (beginning-of-line) (point)) 3329 (point)))) 3330 "[^;]")) 3331 3332 ;; Mark the beginning and end of the paragraph 3333 (goto-char bcl) 3334 (while (and (looking-at fill-prefix-reg) 3335 (not (looking-at paragraph-separate)) 3336 (not (bobp))) 3337 (forward-line -1)) 3338 ;; Move to first line of paragraph 3339 (if (/= (point) bcl) 3340 (forward-line 1)) 3341 (setq start (point)) 3342 (goto-char bcl) 3343 (while (and (looking-at fill-prefix-reg) 3344 (not (looking-at paragraph-separate)) 3345 (not (eobp))) 3346 (forward-line 1)) 3347 (beginning-of-line) 3348 (if (or (not (looking-at fill-prefix-reg)) 3349 (looking-at paragraph-separate)) 3350 (forward-line -1)) 3351 (end-of-line) 3352 ;; if at end of buffer add a newline (need this because 3353 ;; fill-region needs END to be at the beginning of line after 3354 ;; the paragraph or it will add a line). 3355 (if (eobp) 3356 (progn (insert ?\n) (backward-char 1))) 3357 ;; Set END to the beginning of line after the paragraph 3358 ;; END is calculated as distance from end of buffer 3359 (setq end (- (point-max) (point) 1)) 3360 ;; 3361 ;; Calculate the indentation for the paragraph. 3362 ;; 3363 ;; In the following while statements, after one iteration 3364 ;; point will be at the beginning of a line in which case 3365 ;; the while will not be executed for the 3366 ;; the first paragraph line and thus will not affect the 3367 ;; indentation. 3368 ;; 3369 ;; First check to see if indentation is based on hanging indent. 3370 (if (and (not nohang) idlwave-hanging-indent 3371 (setq hang 3372 (save-excursion 3373 (goto-char start) 3374 (idlwave-calc-hanging-indent)))) 3375 ;; Adjust lines of paragraph by inserting spaces so that 3376 ;; each line's indent is at least as great as the hanging 3377 ;; indent. This is needed for fill-paragraph to work with 3378 ;; a fill-prefix. 3379 (progn 3380 (setq indent hang) 3381 (beginning-of-line) 3382 (while (> (point) start) 3383 (re-search-forward comment-start-skip 3384 (save-excursion (end-of-line) (point)) 3385 t) 3386 (if (> (setq diff (- indent (current-column))) 0) 3387 (progn 3388 (if (>= here (point)) 3389 ;; adjust the original location for the 3390 ;; inserted text. 3391 (setq here (+ here diff))) 3392 (insert (make-string diff ?\ )))) 3393 (forward-line -1)) 3394 ) 3395 3396 ;; No hang. Instead find minimum indentation of paragraph 3397 ;; after first line. 3398 ;; For the following while statement, since START is at the 3399 ;; beginning of line and END is at the end of line 3400 ;; point is greater than START at least once (which would 3401 ;; be the case for a single line paragraph). 3402 (while (> (point) start) 3403 (beginning-of-line) 3404 (setq indent 3405 (min indent 3406 (progn 3407 (re-search-forward 3408 comment-start-skip 3409 (save-excursion (end-of-line) (point)) 3410 t) 3411 (current-column)))) 3412 (forward-line -1)) 3413 ) 3414 (setq fill-prefix (concat fill-prefix 3415 (make-string (- indent pre) 3416 ?\ ))) 3417 ;; first-line indent 3418 (setq first-indent 3419 (max 3420 (progn 3421 (re-search-forward 3422 comment-start-skip 3423 (save-excursion (end-of-line) (point)) 3424 t) 3425 (current-column)) 3426 indent)) 3427 3428 ;; try to keep point at its original place 3429 (goto-char here) 3430 3431 ;; In place of the more modern fill-region-as-paragraph, a hack 3432 ;; to keep whitespace untouched on the first line within the 3433 ;; indent length and to preserve any indent on the first line 3434 ;; (first indent). 3435 (save-excursion 3436 (setq diff 3437 (buffer-substring start (+ start first-indent -1))) 3438 (subst-char-in-region start (+ start first-indent -1) ?\ ?~ nil) 3439 (fill-region-as-paragraph 3440 start 3441 (- (point-max) end) 3442 (current-justification) 3443 nil) 3444 (delete-region start (+ start first-indent -1)) 3445 (goto-char start) 3446 (insert diff)) 3447 ;; When we want the point at the beginning of the comment 3448 ;; body fill-region will put it at the beginning of the line. 3449 (if (bolp) (skip-chars-forward (concat " \t" comment-start))) 3450 (setq fill-prefix nil)))) 3451 3452(defun idlwave-calc-hanging-indent () 3453 "Calculate the position of the hanging indent for the comment 3454paragraph. The hanging indent position is given by the first match 3455with the `idlwave-hang-indent-regexp'. If `idlwave-use-last-hang-indent' is 3456non-nil then use last occurrence matching `idlwave-hang-indent-regexp' on 3457the line. 3458If not found returns nil." 3459 (if idlwave-use-last-hang-indent 3460 (save-excursion 3461 (end-of-line) 3462 (if (re-search-backward 3463 idlwave-hang-indent-regexp 3464 (save-excursion (beginning-of-line) (point)) 3465 t) 3466 (+ (current-column) (length idlwave-hang-indent-regexp)))) 3467 (save-excursion 3468 (beginning-of-line) 3469 (if (re-search-forward 3470 idlwave-hang-indent-regexp 3471 (save-excursion (end-of-line) (point)) 3472 t) 3473 (current-column))))) 3474 3475(defun idlwave-auto-fill () 3476 "Called to break lines in auto fill mode. 3477Only fills non-comment lines if `idlwave-fill-comment-line-only' is 3478non-nil. Places a continuation character at the end of the line if 3479not in a comment. Splits strings with IDL concatenation operator `+' 3480if `idlwave-auto-fill-split-string' is non-nil." 3481 (if (<= (current-column) fill-column) 3482 nil ; do not to fill 3483 (if (or (not idlwave-fill-comment-line-only) 3484 (save-excursion 3485 ;; Check for comment line 3486 (beginning-of-line) 3487 (looking-at idlwave-comment-line-start-skip))) 3488 (let (beg) 3489 (idlwave-indent-line) 3490 ;; Prevent actions do-auto-fill which calls indent-line-function. 3491 (let (idlwave-do-actions 3492 (paragraph-separate ".") 3493 (fill-nobreak-predicate 3494 (if (and (idlwave-in-quote) 3495 idlwave-auto-fill-split-string) 3496 (lambda () ;; We'll need 5 spaces for " ' + $" 3497 (<= (- fill-column (current-column)) 5) 3498 )))) 3499 (do-auto-fill)) 3500 (save-excursion 3501 (end-of-line 0) 3502 ;; Indent the split line 3503 (idlwave-indent-line)) 3504 (if (save-excursion 3505 (beginning-of-line) 3506 (looking-at idlwave-comment-line-start-skip)) 3507 ;; A continued line comment 3508 ;; We treat continued line comments as part of a comment 3509 ;; paragraph. So we check for a hanging indent. 3510 (if idlwave-hanging-indent 3511 (let ((here (- (point-max) (point))) 3512 (indent 3513 (save-excursion 3514 (forward-line -1) 3515 (idlwave-calc-hanging-indent)))) 3516 (if indent 3517 (progn 3518 ;; Remove whitespace between comment delimiter and 3519 ;; text, insert spaces for appropriate indentation. 3520 (beginning-of-line) 3521 (re-search-forward 3522 comment-start-skip 3523 (save-excursion (end-of-line) (point)) t) 3524 (delete-horizontal-space) 3525 (idlwave-indent-to indent) 3526 (goto-char (- (point-max) here))) 3527 ))) 3528 ;; Split code or comment? 3529 (if (save-excursion 3530 (end-of-line 0) 3531 (idlwave-in-comment)) 3532 ;; Splitting a non-full-line comment. 3533 ;; Insert the comment delimiter from split line 3534 (progn 3535 (save-excursion 3536 (beginning-of-line) 3537 (skip-chars-forward " \t") 3538 ;; Insert blank to keep off beginning of line 3539 (insert " " 3540 (save-excursion 3541 (forward-line -1) 3542 (buffer-substring (idlwave-goto-comment) 3543 (progn 3544 (skip-chars-forward "; ") 3545 (point)))))) 3546 (idlwave-indent-line)) 3547 ;; Split code line - add continuation character 3548 (save-excursion 3549 (end-of-line 0) 3550 ;; Check to see if we split a string 3551 (if (and (setq beg (idlwave-in-quote)) 3552 idlwave-auto-fill-split-string) 3553 ;; Split the string and concatenate. 3554 ;; The first extra space is for the space 3555 ;; the line was split. That space was removed. 3556 (insert " " (char-after beg) " +")) 3557 (insert " $")) 3558 (if beg 3559 (if idlwave-auto-fill-split-string 3560 ;; Make the second part of continued string 3561 (save-excursion 3562 (beginning-of-line) 3563 (skip-chars-forward " \t") 3564 (insert (char-after beg))) 3565 ;; Warning 3566 (beep) 3567 (message "Warning: continuation inside a string."))) 3568 ;; Although do-auto-fill (via indent-new-comment-line) calls 3569 ;; idlwave-indent-line for the new line, re-indent again 3570 ;; because of the addition of the continuation character. 3571 (idlwave-indent-line)) 3572 ))))) 3573 3574(defun idlwave-auto-fill-mode (arg) 3575 "Toggle auto-fill mode for IDL mode. 3576With arg, turn auto-fill mode on if arg is positive. 3577In auto-fill mode, inserting a space at a column beyond `fill-column' 3578automatically breaks the line at a previous space." 3579 (interactive "P") 3580 (prog1 (set idlwave-fill-function 3581 (if (if (null arg) 3582 (not (symbol-value idlwave-fill-function)) 3583 (> (prefix-numeric-value arg) 0)) 3584 'idlwave-auto-fill 3585 nil)) 3586 ;; update mode-line 3587 (set-buffer-modified-p (buffer-modified-p)))) 3588 3589;(defun idlwave-fill-routine-call () 3590; "Fill a routine definition or statement, indenting appropriately." 3591; (let ((where (idlwave-where))))) 3592 3593 3594(defun idlwave-doc-header (&optional nomark ) 3595 "Insert a documentation header at the beginning of the unit. 3596Inserts the value of the variable idlwave-file-header. Sets mark before 3597moving to do insertion unless the optional prefix argument NOMARK 3598is non-nil." 3599 (interactive "P") 3600 (or nomark (push-mark)) 3601 ;; make sure we catch the current line if it begins the unit 3602 (if idlwave-header-to-beginning-of-file 3603 (goto-char (point-min)) 3604 (end-of-line) 3605 (idlwave-beginning-of-subprogram) 3606 (beginning-of-line) 3607 ;; skip function or procedure line 3608 (if (idlwave-look-at "\\<\\(pro\\|function\\)\\>") 3609 (progn 3610 (idlwave-end-of-statement) 3611 (if (> (forward-line 1) 0) (insert "\n"))))) 3612 (let ((pos (point))) 3613 (if idlwave-file-header 3614 (cond ((car idlwave-file-header) 3615 (insert-file-contents (car idlwave-file-header))) 3616 ((stringp (car (cdr idlwave-file-header))) 3617 (insert (car (cdr idlwave-file-header)))))) 3618 (goto-char pos))) 3619 3620(defun idlwave-default-insert-timestamp () 3621 "Default timestamp insertion function" 3622 (insert (current-time-string)) 3623 (insert ", " (user-full-name)) 3624 (if (boundp 'user-mail-address) 3625 (insert " <" user-mail-address ">") 3626 (insert " <" (user-login-name) "@" (system-name) ">")) 3627 ;; Remove extra spaces from line 3628 (idlwave-fill-paragraph) 3629 ;; Insert a blank line comment to separate from the date entry - 3630 ;; will keep the entry from flowing onto date line if re-filled. 3631 (insert "\n;\n;\t\t")) 3632 3633(defun idlwave-doc-modification () 3634 "Insert a brief modification log at the beginning of the current program. 3635Looks for an occurrence of the value of user variable 3636`idlwave-doc-modifications-keyword' if non-nil. Inserts time and user name 3637and places the point for the user to add a log. Before moving, saves 3638location on mark ring so that the user can return to previous point." 3639 (interactive) 3640 (push-mark) 3641 (let* (beg end) 3642 (if (and (or (re-search-backward idlwave-doclib-start nil t) 3643 (progn 3644 (goto-char (point-min)) 3645 (re-search-forward idlwave-doclib-start nil t))) 3646 (setq beg (match-beginning 0)) 3647 (re-search-forward idlwave-doclib-end nil t) 3648 (setq end (match-end 0))) 3649 (progn 3650 (goto-char beg) 3651 (if (re-search-forward 3652 (concat idlwave-doc-modifications-keyword ":") 3653 end t) 3654 (end-of-line) 3655 (goto-char end) 3656 (end-of-line -1) 3657 (insert "\n" comment-start "\n") 3658 (insert comment-start " " idlwave-doc-modifications-keyword ":")) 3659 (insert "\n;\n;\t") 3660 (run-hooks 'idlwave-timestamp-hook)) 3661 (error "No valid DOCLIB header")))) 3662 3663 3664;;; CJC 3/16/93 3665;;; Interface to expand-region-abbrevs which did not work when the 3666;;; abbrev hook associated with an abbrev moves point backwards 3667;;; after abbrev expansion, e.g., as with the abbrev '.n'. 3668;;; The original would enter an infinite loop in attempting to expand 3669;;; .n (it would continually expand and unexpand the abbrev without expanding 3670;;; because the point would keep going back to the beginning of the 3671;;; abbrev instead of to the end of the abbrev). We now keep the 3672;;; abbrev hook from moving backwards. 3673;;; 3674(defun idlwave-expand-region-abbrevs (start end) 3675 "Expand each abbrev occurrence in the region. 3676Calling from a program, arguments are START END." 3677 (interactive "r") 3678 (save-excursion 3679 (goto-char (min start end)) 3680 (let ((idlwave-show-block nil) ;Do not blink 3681 (idlwave-abbrev-move nil)) ;Do not move 3682 (expand-region-abbrevs start end 'noquery)))) 3683 3684(defun idlwave-quoted () 3685 "Returns t if point is in a comment or quoted string. 3686nil otherwise." 3687 (or (idlwave-in-comment) (idlwave-in-quote))) 3688 3689(defun idlwave-in-quote () 3690 "Returns location of the opening quote 3691if point is in a IDL string constant, nil otherwise. 3692Ignores comment delimiters on the current line. 3693Properly handles nested quotation marks and octal 3694constants - a double quote followed by an octal digit." 3695;;; Treat an octal inside an apostrophe to be a normal string. Treat a 3696;;; double quote followed by an octal digit to be an octal constant 3697;;; rather than a string. Therefore, there is no terminating double 3698;;; quote. 3699 (save-excursion 3700 ;; Because single and double quotes can quote each other we must 3701 ;; search for the string start from the beginning of line. 3702 (let* ((start (point)) 3703 (eol (progn (end-of-line) (point))) 3704 (bq (progn (beginning-of-line) (point))) 3705 (endq (point)) 3706 (data (match-data)) 3707 delim 3708 found) 3709 (while (< endq start) 3710 ;; Find string start 3711 ;; Don't find an octal constant beginning with a double quote 3712 (if (re-search-forward "[\"']" eol 'lim) 3713 ;; Find the string end. 3714 ;; In IDL, two consecutive delimiters after the start of a 3715 ;; string act as an 3716 ;; escape for the delimiter in the string. 3717 ;; Two consecutive delimiters alone (i.e., not after the 3718 ;; start of a string) is the null string. 3719 (progn 3720 ;; Move to position after quote 3721 (goto-char (1+ (match-beginning 0))) 3722 (setq bq (1- (point))) 3723 ;; Get the string delimiter 3724 (setq delim (char-to-string (preceding-char))) 3725 ;; Check for null string 3726 (if (looking-at delim) 3727 (progn (setq endq (point)) (forward-char 1)) 3728 ;; Look for next unpaired delimiter 3729 (setq found (search-forward delim eol 'lim)) 3730 (while (looking-at delim) 3731 (forward-char 1) 3732 (setq found (search-forward delim eol 'lim))) 3733 (if found 3734 (setq endq (- (point) 1)) 3735 (setq endq (point))) 3736 )) 3737 (progn (setq bq (point)) (setq endq (point))))) 3738 (store-match-data data) 3739 ;; return string beginning position or nil 3740 (if (> start bq) bq)))) 3741 3742(defun idlwave-is-pointer-dereference (&optional limit) 3743 "Determines if the character after point is a pointer dereference *." 3744 (let ((pos (point))) 3745 (and 3746 (eq (char-after) ?\*) 3747 (not (idlwave-in-quote)) 3748 (save-excursion 3749 (forward-char) 3750 (re-search-backward (concat "\\(" idlwave-idl-keywords 3751 "\\|[[(*+-/=,^><]\\)\\s-*\\*") limit t))))) 3752 3753 3754;; Statement templates 3755 3756;; Replace these with a general template function, something like 3757;; expand.el (I think there was also something with a name similar to 3758;; dmacro.el) 3759 3760(defun idlwave-template (s1 s2 &optional prompt noindent) 3761 "Build a template with optional prompt expression. 3762 3763Opens a line if point is not followed by a newline modulo intervening 3764whitespace. S1 and S2 are strings. S1 is inserted at point followed 3765by S2. Point is inserted between S1 and S2. The case of S1 and S2 is 3766adjusted according to `idlwave-abbrev-change-case'. If optional argument 3767PROMPT is a string then it is displayed as a message in the 3768minibuffer. The PROMPT serves as a reminder to the user of an 3769expression to enter. 3770 3771The lines containing S1 and S2 are reindented using `indent-region' 3772unless the optional second argument NOINDENT is non-nil." 3773 (if (eq major-mode 'idlwave-shell-mode) 3774 ;; This is a gross hack to avoit template abbrev expansion 3775 ;; in the shell. FIXME: This is a dirty hack. 3776 (if (and (eq this-command 'self-insert-command) 3777 (equal last-abbrev-location (point))) 3778 (insert last-abbrev-text) 3779 (error "No templates in idlwave-shell")) 3780 (cond ((eq idlwave-abbrev-change-case 'down) 3781 (setq s1 (downcase s1) s2 (downcase s2))) 3782 (idlwave-abbrev-change-case 3783 (setq s1 (upcase s1) s2 (upcase s2)))) 3784 (let ((beg (save-excursion (beginning-of-line) (point))) 3785 end) 3786 (if (not (looking-at "\\s-*\n")) 3787 (open-line 1)) 3788 (insert s1) 3789 (save-excursion 3790 (insert s2) 3791 (setq end (point))) 3792 (if (not noindent) 3793 (indent-region beg end nil)) 3794 (if (stringp prompt) 3795 (message prompt))))) 3796 3797(defun idlwave-rw-case (string) 3798 "Make STRING have the case required by `idlwave-reserved-word-upcase'." 3799 (if idlwave-reserved-word-upcase 3800 (upcase string) 3801 string)) 3802 3803(defun idlwave-elif () 3804 "Build skeleton IDL if-else block." 3805 (interactive) 3806 (idlwave-template 3807 (idlwave-rw-case "if") 3808 (idlwave-rw-case " then begin\n\nendif else begin\n\nendelse") 3809 "Condition expression")) 3810 3811(defun idlwave-case () 3812 "Build skeleton IDL case statement." 3813 (interactive) 3814 (idlwave-template 3815 (idlwave-rw-case "case") 3816 (idlwave-rw-case " of\n\nendcase") 3817 "Selector expression")) 3818 3819(defun idlwave-switch () 3820 "Build skeleton IDL switch statement." 3821 (interactive) 3822 (idlwave-template 3823 (idlwave-rw-case "switch") 3824 (idlwave-rw-case " of\n\nendswitch") 3825 "Selector expression")) 3826 3827(defun idlwave-for () 3828 "Build skeleton for loop statment." 3829 (interactive) 3830 (idlwave-template 3831 (idlwave-rw-case "for") 3832 (idlwave-rw-case " do begin\n\nendfor") 3833 "Loop expression")) 3834 3835(defun idlwave-if () 3836 "Build skeleton for loop statment." 3837 (interactive) 3838 (idlwave-template 3839 (idlwave-rw-case "if") 3840 (idlwave-rw-case " then begin\n\nendif") 3841 "Scalar logical expression")) 3842 3843(defun idlwave-procedure () 3844 (interactive) 3845 (idlwave-template 3846 (idlwave-rw-case "pro") 3847 (idlwave-rw-case "\n\nreturn\nend") 3848 "Procedure name")) 3849 3850(defun idlwave-function () 3851 (interactive) 3852 (idlwave-template 3853 (idlwave-rw-case "function") 3854 (idlwave-rw-case "\n\nreturn\nend") 3855 "Function name")) 3856 3857(defun idlwave-repeat () 3858 (interactive) 3859 (idlwave-template 3860 (idlwave-rw-case "repeat begin\n\nendrep until") 3861 (idlwave-rw-case "") 3862 "Exit condition")) 3863 3864(defun idlwave-while () 3865 (interactive) 3866 (idlwave-template 3867 (idlwave-rw-case "while") 3868 (idlwave-rw-case " do begin\n\nendwhile") 3869 "Entry condition")) 3870 3871(defun idlwave-split-string (string &optional pattern) 3872 "Return a list of substrings of STRING which are separated by PATTERN. 3873If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." 3874 (or pattern 3875 (setq pattern "[ \f\t\n\r\v]+")) 3876 (let (parts (start 0)) 3877 (while (string-match pattern string start) 3878 (setq parts (cons (substring string start (match-beginning 0)) parts) 3879 start (match-end 0))) 3880 (nreverse (cons (substring string start) parts)))) 3881 3882(defun idlwave-replace-string (string replace_string replace_with) 3883 (let* ((start 0) 3884 (last (length string)) 3885 (ret_string "") 3886 end) 3887 (while (setq end (string-match replace_string string start)) 3888 (setq ret_string 3889 (concat ret_string (substring string start end) replace_with)) 3890 (setq start (match-end 0))) 3891 (setq ret_string (concat ret_string (substring string start last))))) 3892 3893(defun idlwave-get-buffer-visiting (file) 3894 ;; Return the buffer currently visiting FILE 3895 (cond 3896 ((boundp 'find-file-compare-truenames) ; XEmacs 3897 (let ((find-file-compare-truenames t)) 3898 (get-file-buffer file))) 3899 ((fboundp 'find-buffer-visiting) ; Emacs 3900 (find-buffer-visiting file)) 3901 (t (error "This should not happen (idlwave-get-buffer-visiting)")))) 3902 3903(defvar idlwave-outlawed-buffers nil 3904 "List of buffer pulled up by idlwave for special reasons. 3905Buffers in this list may be killed by `idlwave-kill-autoloaded-buffers'.") 3906 3907(defun idlwave-find-file-noselect (file &optional why) 3908 ;; Return a buffer visiting file. 3909 (or (idlwave-get-buffer-visiting file) 3910 (let ((buf (find-file-noselect file))) 3911 (if why (add-to-list 'idlwave-outlawed-buffers (cons buf why))) 3912 buf))) 3913 3914(defun idlwave-kill-autoloaded-buffers () 3915 "Kill buffers created automatically by IDLWAVE. 3916Function prompts for a letter to identify the buffers to kill. 3917Possible letters are: 3918 3919f Buffers created by the command \\[idlwave-find-module] or mouse 3920 clicks in the routine info window. 3921s Buffers created by the IDLWAVE Shell to display where execution 3922 stopped or an error was found. 3923a Both of the above. 3924 3925Buffer containing unsaved changes require confirmation before they are killed." 3926 (interactive) 3927 (if (null idlwave-outlawed-buffers) 3928 (error "No IDLWAVE-created buffers available") 3929 (princ (format "Kill IDLWAVE-created buffers: [f]ind source(%d), [s]hell display(%d), [a]ll ? " 3930 (idlwave-count-outlawed-buffers 'find) 3931 (idlwave-count-outlawed-buffers 'shell))) 3932 (let ((c (read-char))) 3933 (cond 3934 ((member c '(?f ?\C-f)) 3935 (idlwave-do-kill-autoloaded-buffers 'find)) 3936 ((member c '(?s ?\C-s)) 3937 (idlwave-do-kill-autoloaded-buffers 'shell)) 3938 ((member c '(?a ?\C-a)) 3939 (idlwave-do-kill-autoloaded-buffers t)) 3940 (t (error "Abort")))))) 3941 3942(defun idlwave-count-outlawed-buffers (tag) 3943 "How many outlawed buffers have tag TAG?" 3944 (length (delq nil 3945 (mapcar 3946 (lambda (x) (eq (cdr x) tag)) 3947 idlwave-outlawed-buffers)))) 3948 3949(defun idlwave-do-kill-autoloaded-buffers (&rest reasons) 3950 "Kill all buffers pulled up by IDLWAVE matching REASONS." 3951 (let* ((list (copy-sequence idlwave-outlawed-buffers)) 3952 (cnt 0) 3953 entry) 3954 (while (setq entry (pop list)) 3955 (if (buffer-live-p (car entry)) 3956 (and (or (memq t reasons) 3957 (memq (cdr entry) reasons)) 3958 (kill-buffer (car entry)) 3959 (incf cnt) 3960 (setq idlwave-outlawed-buffers 3961 (delq entry idlwave-outlawed-buffers))) 3962 (setq idlwave-outlawed-buffers 3963 (delq entry idlwave-outlawed-buffers)))) 3964 (message "%d buffer%s killed" cnt (if (= cnt 1) "" "s")))) 3965 3966(defun idlwave-revoke-license-to-kill () 3967 "Remove BUFFER from the buffers which may be killed. 3968Killing would be done by `idlwave-do-kill-autoloaded-buffers'. 3969Intended for `after-save-hook'." 3970 (let* ((buf (current-buffer)) 3971 (entry (assq buf idlwave-outlawed-buffers))) 3972 ;; Revoke license 3973 (if entry 3974 (setq idlwave-outlawed-buffers 3975 (delq entry idlwave-outlawed-buffers))) 3976 ;; Remove this function from the hook. 3977 (remove-hook 'after-save-hook 'idlwave-revoke-license-to-kill 'local))) 3978 3979(defvar idlwave-path-alist) 3980(defun idlwave-locate-lib-file (file) 3981 ;; Find FILE on the scanned lib path and return a buffer visiting it 3982 (let* ((dirs idlwave-path-alist) 3983 dir efile) 3984 (catch 'exit 3985 (while (setq dir (car (pop dirs))) 3986 (if (file-regular-p 3987 (setq efile (expand-file-name file dir))) 3988 (throw 'exit efile)))))) 3989 3990(defun idlwave-expand-lib-file-name (file) 3991 ;; Find FILE on the scanned lib path and return a buffer visiting it 3992 ;; This is for, e.g., finding source with no user catalog 3993 (cond 3994 ((null file) nil) 3995 ((file-name-absolute-p file) file) 3996 (t (idlwave-locate-lib-file file)))) 3997 3998(defun idlwave-make-tags () 3999 "Creates the IDL tags file IDLTAGS in the current directory from 4000the list of directories specified in the minibuffer. Directories may be 4001for example: . /usr/local/rsi/idl/lib. All the subdirectories of the 4002specified top directories are searched if the directory name is prefixed 4003by @. Specify @ directories with care, it may take a long, long time if 4004you specify /." 4005 (interactive) 4006 (let (directory directories cmd append status numdirs dir getsubdirs 4007 buffer save_buffer files numfiles item errbuf) 4008 4009 ;; 4010 ;; Read list of directories 4011 (setq directory (read-string "Tag Directories: " ".")) 4012 (setq directories (idlwave-split-string directory "[ \t]+")) 4013 ;; 4014 ;; Set etags command, vars 4015 (setq cmd "etags --output=IDLTAGS --language=none --regex='/[ 4016\\t]*[pP][Rr][Oo][ \\t]+\\([^ \\t,]+\\)/' --regex='/[ 4017\\t]*[Ff][Uu][Nn][Cc][Tt][Ii][Oo][Nn][ \\t]+\\([^ \\t,]+\\)/' ") 4018 (setq append " ") 4019 (setq status 0) 4020 ;; 4021 ;; For each directory 4022 (setq numdirs 0) 4023 (setq dir (nth numdirs directories)) 4024 (while (and dir) 4025 ;; 4026 ;; Find the subdirectories 4027 (if (string-match "^[@]\\(.+\\)$" dir) 4028 (setq getsubdirs t) (setq getsubdirs nil)) 4029 (if (and getsubdirs) (setq dir (substring dir 1 (length dir)))) 4030 (setq dir (expand-file-name dir)) 4031 (if (file-directory-p dir) 4032 (progn 4033 (if (and getsubdirs) 4034 (progn 4035 (setq buffer (get-buffer-create "*idltags*")) 4036 (call-process "sh" nil buffer nil "-c" 4037 (concat "find " dir " -type d -print")) 4038 (setq save_buffer (current-buffer)) 4039 (set-buffer buffer) 4040 (setq files (idlwave-split-string 4041 (idlwave-replace-string 4042 (buffer-substring 1 (point-max)) 4043 "\n" "/*.pro ") 4044 "[ \t]+")) 4045 (set-buffer save_buffer) 4046 (kill-buffer buffer)) 4047 (setq files (list (concat dir "/*.pro")))) 4048 ;; 4049 ;; For each subdirectory 4050 (setq numfiles 0) 4051 (setq item (nth numfiles files)) 4052 (while (and item) 4053 ;; 4054 ;; Call etags 4055 (if (not (string-match "^[ \\t]*$" item)) 4056 (progn 4057 (message "%s" (concat "Tagging " item "...")) 4058 (setq errbuf (get-buffer-create "*idltags-error*")) 4059 (setq status (+ status 4060 (if (eq 0 (call-process 4061 "sh" nil errbuf nil "-c" 4062 (concat cmd append item))) 4063 0 4064 1))) 4065 ;; 4066 ;; Append additional tags 4067 (setq append " --append ") 4068 (setq numfiles (1+ numfiles)) 4069 (setq item (nth numfiles files))) 4070 (progn 4071 (setq numfiles (1+ numfiles)) 4072 (setq item (nth numfiles files)) 4073 ))) 4074 4075 (setq numdirs (1+ numdirs)) 4076 (setq dir (nth numdirs directories))) 4077 (progn 4078 (setq numdirs (1+ numdirs)) 4079 (setq dir (nth numdirs directories))))) 4080 4081 (setq errbuf (get-buffer-create "*idltags-error*")) 4082 (if (= status 0) 4083 (kill-buffer errbuf)) 4084 (message "") 4085 )) 4086 4087(defun idlwave-toggle-comment-region (beg end &optional n) 4088 "Comment the lines in the region if the first non-blank line is 4089commented, and conversely, uncomment region. If optional prefix arg 4090N is non-nil, then for N positive, add N comment delimiters or for N 4091negative, remove N comment delimiters. 4092Uses `comment-region' which does not place comment delimiters on 4093blank lines." 4094 (interactive "r\nP") 4095 (if n 4096 (comment-region beg end (prefix-numeric-value n)) 4097 (save-excursion 4098 (goto-char beg) 4099 (beginning-of-line) 4100 ;; skip blank lines 4101 (skip-chars-forward " \t\n") 4102 (if (looking-at (concat "[ \t]*\\(" comment-start "+\\)")) 4103 (if (fboundp 'uncomment-region) 4104 (uncomment-region beg end) 4105 (comment-region beg end 4106 (- (length (buffer-substring 4107 (match-beginning 1) 4108 (match-end 1)))))) 4109 (comment-region beg end))))) 4110 4111 4112;; ---------------------------------------------------------------------------- 4113;; ---------------------------------------------------------------------------- 4114;; ---------------------------------------------------------------------------- 4115;; ---------------------------------------------------------------------------- 4116;; 4117;; Completion and Routine Info 4118;; 4119 4120;; String "intern" functions 4121 4122;; For the completion and routine info function, we want to normalize 4123;; the case of procedure names etc. We do this by "interning" these 4124;; string is a hand-crafted way. Hashes are used to map the downcase 4125;; version of the strings to the cased versions. Most *-sint-* 4126;; variables consist of *two* hashes, a buffer+shell, followed by a 4127;; system hash. The former is re-scanned, and the latter takes case 4128;; precedence. 4129;; 4130;; Since these cased versions are really lisp objects, we can use `eq' 4131;; to search, which is a large performance boost. All new strings 4132;; need to be "sinterned". We do this as early as possible after 4133;; getting these strings from completion or buffer substrings. So 4134;; most of the code can simply assume to deal with "sinterned" 4135;; strings. The only exception is that the functions which scan whole 4136;; buffers for routine information do not intern the grabbed strings. 4137;; This is only done afterwards. Therefore in these functions it is 4138;; *not* safe to assume the strings can be compared with `eq' and be 4139;; fed into the routine assq functions. 4140 4141;; Here we define the hashing functions. 4142 4143;; The variables which hold the hashes. 4144(defvar idlwave-sint-routines '(nil)) 4145(defvar idlwave-sint-keywords '(nil)) 4146(defvar idlwave-sint-methods '(nil)) 4147(defvar idlwave-sint-classes '(nil)) 4148(defvar idlwave-sint-dirs '(nil)) 4149(defvar idlwave-sint-libnames '(nil)) 4150 4151(defun idlwave-reset-sintern (&optional what) 4152 "Reset all sintern hashes." 4153 ;; Make sure the hash functions are accessible. 4154 (if (or (not (fboundp 'gethash)) 4155 (not (fboundp 'puthash))) 4156 (progn 4157 (require 'cl) 4158 (or (fboundp 'puthash) 4159 (defalias 'puthash 'cl-puthash)))) 4160 (let ((entries '((idlwave-sint-routines 1000 10) 4161 (idlwave-sint-keywords 1000 10) 4162 (idlwave-sint-methods 100 10) 4163 (idlwave-sint-classes 10 10)))) 4164 4165 ;; Make sure these are lists 4166 (loop for entry in entries 4167 for var = (car entry) 4168 do (if (not (consp (symbol-value var))) (set var (list nil)))) 4169 4170 ;; Reset the system & library hash 4171 (when (or (eq what t) (eq what 'syslib) 4172 (null (cdr idlwave-sint-routines))) 4173 (loop for entry in entries 4174 for var = (car entry) for size = (nth 1 entry) 4175 do (setcdr (symbol-value var) 4176 (make-hash-table ':size size ':test 'equal))) 4177 (setq idlwave-sint-dirs nil 4178 idlwave-sint-libnames nil)) 4179 4180 ;; Reset the buffer & shell hash 4181 (when (or (eq what t) (eq what 'bufsh) 4182 (null (car idlwave-sint-routines))) 4183 (loop for entry in entries 4184 for var = (car entry) for size = (nth 1 entry) 4185 do (setcar (symbol-value var) 4186 (make-hash-table ':size size ':test 'equal)))))) 4187 4188(defun idlwave-sintern-routine-or-method (name &optional class set) 4189 (if class 4190 (idlwave-sintern-method name set) 4191 (idlwave-sintern-routine name set))) 4192 4193(defun idlwave-sintern (stype &rest args) 4194 (apply (intern (concat "idlwave-sintern-" (symbol-name stype))) args)) 4195 4196;;(defmacro idlwave-sintern (type var) 4197;; `(cond ((not (stringp name)) name) 4198;; ((gethash (downcase name) (cdr ,var))) 4199;; ((gethash (downcase name) (car ,var))) 4200;; (set (idlwave-sintern-set name ,type ,var set)) 4201;; (name))) 4202 4203(defun idlwave-sintern-routine (name &optional set) 4204 (cond ((not (stringp name)) name) 4205 ((gethash (downcase name) (cdr idlwave-sint-routines))) 4206 ((gethash (downcase name) (car idlwave-sint-routines))) 4207 (set (idlwave-sintern-set name 'routine idlwave-sint-routines set)) 4208 (name))) 4209(defun idlwave-sintern-keyword (name &optional set) 4210 (cond ((not (stringp name)) name) 4211 ((gethash (downcase name) (cdr idlwave-sint-keywords))) 4212 ((gethash (downcase name) (car idlwave-sint-keywords))) 4213 (set (idlwave-sintern-set name 'keyword idlwave-sint-keywords set)) 4214 (name))) 4215(defun idlwave-sintern-method (name &optional set) 4216 (cond ((not (stringp name)) name) 4217 ((gethash (downcase name) (cdr idlwave-sint-methods))) 4218 ((gethash (downcase name) (car idlwave-sint-methods))) 4219 (set (idlwave-sintern-set name 'method idlwave-sint-methods set)) 4220 (name))) 4221(defun idlwave-sintern-class (name &optional set) 4222 (cond ((not (stringp name)) name) 4223 ((gethash (downcase name) (cdr idlwave-sint-classes))) 4224 ((gethash (downcase name) (car idlwave-sint-classes))) 4225 (set (idlwave-sintern-set name 'class idlwave-sint-classes set)) 4226 (name))) 4227 4228(defun idlwave-sintern-dir (dir &optional set) 4229 (car (or (member dir idlwave-sint-dirs) 4230 (setq idlwave-sint-dirs (cons dir idlwave-sint-dirs))))) 4231(defun idlwave-sintern-libname (name &optional set) 4232 (car (or (member name idlwave-sint-libnames) 4233 (setq idlwave-sint-libnames (cons name idlwave-sint-libnames))))) 4234 4235(defun idlwave-sintern-set (name type tables set) 4236 (let* ((func (or (cdr (assq type idlwave-completion-case)) 4237 'identity)) 4238 (iname (funcall (if (eq func 'preserve) 'identity func) name)) 4239 (table (if (eq set 'sys) (cdr tables) (car tables)))) 4240 (puthash (downcase name) iname table) 4241 iname)) 4242 4243(defun idlwave-sintern-keyword-list (kwd-list &optional set) 4244 "Sintern a set of keywords (file (key . link) (key2 . link2) ...)" 4245 (mapcar (lambda(x) 4246 (setcar x (idlwave-sintern-keyword (car x) set))) 4247 (cdr kwd-list)) 4248 kwd-list) 4249 4250(defun idlwave-sintern-rinfo-list (list &optional set default-dir) 4251 "Sintern all strings in the rinfo LIST. With optional parameter 4252SET: also set new patterns. Probably this will always have to be t. 4253If DEFAULT-DIR is passed, it is used as the base of the directory" 4254 (let (entry name type class kwds res source call new) 4255 (while list 4256 (setq entry (car list) 4257 list (cdr list) 4258 name (car entry) 4259 type (nth 1 entry) 4260 class (nth 2 entry) 4261 source (nth 3 entry) 4262 call (nth 4 entry) 4263 kwds (nthcdr 5 entry)) 4264 4265 ;; The class and name 4266 (if class 4267 (progn 4268 (if (symbolp class) (setq class (symbol-name class))) 4269 (setq class (idlwave-sintern-class class set)) 4270 (setq name (idlwave-sintern-method name set))) 4271 (setq name (idlwave-sintern-routine name set))) 4272 4273 ;; The source 4274 (let ((source-type (car source)) 4275 (source-file (nth 1 source)) 4276 (source-dir (if default-dir 4277 (file-name-as-directory default-dir) 4278 (nth 2 source))) 4279 (source-lib (nth 3 source))) 4280 (if (stringp source-dir) 4281 (setq source-dir (idlwave-sintern-dir source-dir set))) 4282 (if (stringp source-lib) 4283 (setq source-lib (idlwave-sintern-libname source-lib set))) 4284 (setq source (list source-type source-file source-dir source-lib))) 4285 4286 ;; The keywords 4287 (setq kwds (mapcar (lambda (x) 4288 (idlwave-sintern-keyword-list x set)) 4289 kwds)) 4290 4291 ;; Build a canonicalized list 4292 (setq new (nconc (list name type class source call) kwds) 4293 res (cons new res))) 4294 (nreverse res))) 4295 4296;; Creating new sintern tables 4297 4298(defun idlwave-new-sintern-type (tag) 4299 "Define a variable and a function to sintern the new type TAG. 4300This defines the function `idlwave-sintern-TAG' and the variable 4301`idlwave-sint-TAGs'." 4302 (let* ((name (symbol-name tag)) 4303 (names (concat name "s")) 4304 (var (intern (concat "idlwave-sint-" names))) 4305 (func (intern (concat "idlwave-sintern-" name)))) 4306 (set var nil) ; initial value of the association list 4307 (fset func ; set the function 4308 `(lambda (name &optional set) 4309 (cond ((not (stringp name)) name) 4310 ((cdr (assoc (downcase name) ,var))) 4311 (set 4312 (setq ,var (cons (cons (downcase name) name) ,var)) 4313 name) 4314 (name)))))) 4315 4316(defun idlwave-reset-sintern-type (tag) 4317 "Reset the sintern variable associated with TAG." 4318 (set (intern (concat "idlwave-sint-" (symbol-name tag) "s")) nil)) 4319 4320;;--------------------------------------------------------------------------- 4321 4322 4323;; The variables which hold the information 4324(defvar idlwave-system-routines nil 4325 "Holds the routine-info obtained by scanning buffers.") 4326(defvar idlwave-buffer-routines nil 4327 "Holds the routine-info obtained by scanning buffers.") 4328(defvar idlwave-compiled-routines nil 4329 "Holds the routine-info obtained by asking the shell.") 4330(defvar idlwave-unresolved-routines nil 4331 "Holds the unresolved routine-info obtained by asking the shell.") 4332(defvar idlwave-user-catalog-routines nil 4333 "Holds the procedure routine-info from the user scan.") 4334(defvar idlwave-library-catalog-routines nil 4335 "Holds the procedure routine-info from the .idlwave_catalog library files.") 4336(defvar idlwave-library-catalog-libname nil 4337 "Name of library catalog loaded from .idlwave_catalog files.") 4338(defvar idlwave-path-alist nil 4339 "Alist with !PATH directories and zero or more flags if the dir has 4340been scanned in a user catalog ('user) or discovered in a library 4341catalog \('lib).") 4342(defvar idlwave-true-path-alist nil 4343 "Like `idlwave-path-alist', but with true filenames.") 4344(defvar idlwave-routines nil 4345 "Holds the combinded procedure/function/method routine-info.") 4346(defvar idlwave-class-alist nil 4347 "Holds the class names known to IDLWAVE.") 4348(defvar idlwave-class-history nil 4349 "The history of classes selected with the minibuffer.") 4350(defvar idlwave-force-class-query nil) 4351(defvar idlwave-before-completion-wconf nil 4352 "The window configuration just before the completion buffer was displayed.") 4353(defvar idlwave-last-system-routine-info-cons-cell nil 4354 "The last cons cell in the system routine info.") 4355 4356;; 4357;; The code to get routine info from different sources. 4358 4359(defvar idlwave-system-routines) 4360(defvar idlwave-catalog-process nil 4361 "The background process currently updating the catalog.") 4362 4363(defun idlwave-routines () 4364 "Provide a list of IDL routines. 4365This routine loads the builtin routines on the first call. Later it 4366only returns the value of the variable." 4367 (if (and idlwave-catalog-process 4368 (processp idlwave-catalog-process)) 4369 (progn 4370 (cond 4371 ((equal (process-status idlwave-catalog-process) 'exit) 4372 (message "updating........") 4373 (setq idlwave-catalog-process nil) 4374 (idlwave-update-routine-info '(4))) 4375 ((equal (process-status idlwave-catalog-process) 'run) 4376 ;; Keep it running... 4377 ) 4378 (t 4379 ;; Something is wrong, get rid of the process 4380 (message "Problem with catalog process") (beep) 4381 (condition-case nil 4382 (kill-process idlwave-catalog-process) 4383 (error nil)) 4384 (setq idlwave-catalog-process nil))))) 4385 (or idlwave-routines 4386 (progn 4387 (idlwave-update-routine-info) 4388 ;; return the current value 4389 idlwave-routines))) 4390 4391(defvar idlwave-update-rinfo-hook nil 4392 "List of functions which should run after a global rinfo update. 4393Does not run after automatic updates of buffer or the shell.") 4394 4395(defun idlwave-rescan-catalog-directories () 4396 "Rescan the previously selected directories. For batch processing." 4397 (idlwave-update-routine-info '(16))) 4398 4399(defun idlwave-rescan-asynchronously () 4400 "Dispatch another Emacs instance to update the idlwave catalog. 4401After the process finishes normally, the first access to routine info 4402will re-read the catalog." 4403 (interactive) 4404 (if (processp idlwave-catalog-process) 4405 (if (eq (process-status idlwave-catalog-process) 'run) 4406 (if (yes-or-no-p "A catalog-updating process is running. Kill it? ") 4407 (progn 4408 (condition-case nil 4409 (kill-process idlwave-catalog-process) 4410 (error nil)) 4411 (error "Process killed, no new process started")) 4412 (error "Quit")) 4413 (condition-case nil 4414 (kill-process idlwave-catalog-process) 4415 (error nil)))) 4416 (if (or (not idlwave-user-catalog-file) 4417 (not (stringp idlwave-user-catalog-file)) 4418 (not (file-regular-p idlwave-user-catalog-file))) 4419 (error "No catalog has been produced yet")) 4420 (let* ((emacs (concat invocation-directory invocation-name)) 4421 (args (list "-batch" 4422 "-l" (expand-file-name "~/.emacs") 4423 "-l" "idlwave" 4424 "-f" "idlwave-rescan-catalog-directories")) 4425 (process (apply 'start-process "idlcat" 4426 nil emacs args))) 4427 (setq idlwave-catalog-process process) 4428 (set-process-sentinel 4429 process 4430 (lambda (pro why) 4431 (when (string-match "finished" why) 4432 (setq idlwave-routines nil 4433 idlwave-system-routines nil 4434 idlwave-catalog-process nil) 4435 (or (idlwave-start-load-rinfo-timer) 4436 (idlwave-update-routine-info '(4)))))) 4437 (message "Background job started to update catalog file"))) 4438 4439 4440;; Format for all routine info user catalog, library catalogs, etc.: 4441;; 4442;; ("ROUTINE" type class 4443;; (system) | (lib pro_file dir "LIBNAME") | (user pro_file dir "USERLIB") | 4444;; (buffer pro_file dir) | (compiled pro_file dir) 4445;; "calling_string" ("HELPFILE" (("KWD1" . link1) ...)) 4446;; ("HELPFILE2" (("KWD2" . link) ...)) ...) 4447;; 4448;; DIR will be supplied dynamically while loading library catalogs, 4449;; and is sinterned to save space, as is LIBNAME. PRO_FILE can be a 4450;; complete filepath, in which case DIR is unnecessary. HELPFILE can 4451;; be nil, as can LINK1, etc., if no HTML help is available. 4452 4453 4454(defvar idlwave-load-rinfo-idle-timer) 4455(defvar idlwave-shell-path-query) 4456 4457(defun idlwave-update-routine-info (&optional arg no-concatenate) 4458 "Update the internal routine-info lists. 4459These lists are used by `idlwave-routine-info' (\\[idlwave-routine-info]) 4460and by `idlwave-complete' (\\[idlwave-complete]) to provide information 4461about individual routines. 4462 4463The information can come from 4 sources: 44641. IDL programs in the current editing session 44652. Compiled modules in an IDL shell running as Emacs subprocess 44663. A list which covers the IDL system routines. 44674. A list which covers the prescanned library files. 4468 4469Scans all IDLWAVE-mode buffers of the current editing session (see 4470`idlwave-scan-all-buffers-for-routine-info'). 4471When an IDL shell is running, this command also queries the IDL program 4472for currently compiled routines. 4473 4474With prefix ARG, also reload the system and library lists. 4475With two prefix ARG's, also rescans the chosen user catalog tree. 4476With three prefix args, dispatch asynchronous process to do the update. 4477 4478If NO-CONCATENATE is non-nil, don't pre-concatenate the routine info 4479lists, but instead wait for the shell query to complete and 4480asynchronously finish updating routine info. This is set 4481automatically when called interactively. When you need routine 4482information updated immediately, leave NO-CONCATENATE nil." 4483 (interactive "P\np") 4484 ;; Stop any idle processing 4485 (if (or (and (fboundp 'itimerp) 4486 (itimerp idlwave-load-rinfo-idle-timer)) 4487 (and (fboundp 'timerp) 4488 (timerp idlwave-load-rinfo-idle-timer))) 4489 (cancel-timer idlwave-load-rinfo-idle-timer)) 4490 (cond 4491 ((equal arg '(64)) 4492 ;; Start a background process which updates the catalog. 4493 (idlwave-rescan-asynchronously)) 4494 ((equal arg '(16)) 4495 ;; Update the user catalog now, and wait for them. 4496 (idlwave-create-user-catalog-file t)) 4497 (t 4498 (let* ((load (or arg 4499 idlwave-buffer-case-takes-precedence 4500 (null idlwave-routines))) 4501 ;; The override-idle means, even if the idle timer has done some 4502 ;; preparing work, load and renormalize everything anyway. 4503 (override-idle (or arg idlwave-buffer-case-takes-precedence))) 4504 4505 (setq idlwave-buffer-routines nil 4506 idlwave-compiled-routines nil 4507 idlwave-unresolved-routines nil) 4508 ;; Reset the appropriate hashes 4509 (if (get 'idlwave-reset-sintern 'done-by-idle) 4510 ;; reset was already done in idle time, so skip this step now once 4511 (put 'idlwave-reset-sintern 'done-by-idle nil) 4512 (idlwave-reset-sintern (cond (load t) 4513 ((null idlwave-system-routines) t) 4514 (t 'bufsh)))) 4515 4516 (if idlwave-buffer-case-takes-precedence 4517 ;; We can safely scan the buffer stuff first 4518 (progn 4519 (idlwave-update-buffer-routine-info) 4520 (and load (idlwave-load-all-rinfo override-idle))) 4521 ;; We first do the system info, and then the buffers 4522 (and load (idlwave-load-all-rinfo override-idle)) 4523 (idlwave-update-buffer-routine-info)) 4524 4525 ;; Let's see if there is a shell 4526 (let* ((shell-is-running (and (fboundp 'idlwave-shell-is-running) 4527 (idlwave-shell-is-running))) 4528 (ask-shell (and shell-is-running 4529 idlwave-query-shell-for-routine-info))) 4530 4531 ;; Load the library catalogs again, first re-scanning the path 4532 (when arg 4533 (if shell-is-running 4534 (idlwave-shell-send-command idlwave-shell-path-query 4535 '(progn 4536 (idlwave-shell-get-path-info) 4537 (idlwave-scan-library-catalogs)) 4538 'hide) 4539 (idlwave-scan-library-catalogs))) 4540 4541 (if (or (not ask-shell) 4542 (not no-concatenate)) 4543 ;; 1. If we are not going to ask the shell, we need to do the 4544 ;; concatenation now. 4545 ;; 2. When this function is called non-interactively, it 4546 ;; means that someone needs routine info *now*. The 4547 ;; shell update causes the concatenation to be 4548 ;; *delayed*, so not in time for the current command. 4549 ;; Therefore, we do a concatenation now, even though 4550 ;; the shell might do it again. 4551 (idlwave-concatenate-rinfo-lists nil 'run-hooks)) 4552 4553 (when ask-shell 4554 ;; Ask the shell about the routines it knows of. 4555 (message "Querying the shell") 4556 (idlwave-shell-update-routine-info nil t))))))) 4557 4558 4559(defvar idlwave-load-rinfo-steps-done (make-vector 6 nil)) 4560(defvar idlwave-load-rinfo-idle-timer nil) 4561(defun idlwave-start-load-rinfo-timer () 4562 (if (or (and (fboundp 'itimerp) 4563 (itimerp idlwave-load-rinfo-idle-timer)) 4564 (and (fboundp 'timerp) 4565 (timerp idlwave-load-rinfo-idle-timer))) 4566 (cancel-timer idlwave-load-rinfo-idle-timer)) 4567 (setq idlwave-load-rinfo-steps-done (make-vector 6 nil)) 4568 (setq idlwave-load-rinfo-idle-timer nil) 4569 (if (and idlwave-init-rinfo-when-idle-after 4570 (numberp idlwave-init-rinfo-when-idle-after) 4571 (not (equal 0 idlwave-init-rinfo-when-idle-after)) 4572 (not idlwave-routines)) 4573 (condition-case nil 4574 (progn 4575 (setq idlwave-load-rinfo-idle-timer 4576 (run-with-idle-timer 4577 idlwave-init-rinfo-when-idle-after 4578 nil 'idlwave-load-rinfo-next-step))) 4579 (error nil)))) 4580 4581(defvar idlwave-library-routines nil "Obsolete variable.") 4582 4583;;------ XML Help routine info system 4584(defun idlwave-load-system-routine-info () 4585 ;; Load the system routine info from the cached routine info file, 4586 ;; which, if necessary, will be re-created from the XML file on 4587 ;; disk. As a last fallback, load the (likely outdated) idlw-rinfo 4588 ;; file distributed with older IDLWAVE versions (<6.0) 4589 (unless (and (load idlwave-xml-system-rinfo-converted-file 4590 'noerror 'nomessage) 4591 (idlwave-xml-system-routine-info-up-to-date)) 4592 ;; See if we can create it from XML source 4593 (condition-case nil 4594 (idlwave-convert-xml-system-routine-info) 4595 (error 4596 (unless (load idlwave-xml-system-rinfo-converted-file 4597 'noerror 'nomessage) 4598 (if idlwave-system-routines 4599 (message 4600 "Failed to load converted routine info, using old conversion.") 4601 (message 4602 "Failed to convert XML routine info, falling back on idlw-rinfo.") 4603 (if (not (load "idlw-rinfo" 'noerror 'nomessage)) 4604 (message 4605 "Could not locate any system routine information.")))))))) 4606 4607(defun idlwave-xml-system-routine-info-up-to-date() 4608 (let* ((dir (file-name-as-directory 4609 (expand-file-name "help/online_help" (idlwave-sys-dir)))) 4610 (catalog-file (expand-file-name "idl_catalog.xml" dir))) 4611 (file-newer-than-file-p ;converted file is newer than catalog 4612 idlwave-xml-system-rinfo-converted-file 4613 catalog-file))) 4614 4615(defvar idlwave-system-class-info nil) ; Gathered from idlw-rinfo 4616(defvar idlwave-system-variables-alist nil 4617 "Alist of system variables and the associated structure tags. 4618Gets set in cached XML rinfo, or `idlw-rinfo.el'.") 4619(defvar idlwave-executive-commands-alist nil 4620 "Alist of system variables and their help files.") 4621(defvar idlwave-help-special-topic-words nil) 4622 4623 4624(defun idlwave-shorten-syntax (syntax name &optional class) 4625 ;; From a list of syntax statments, shorten with %s and group with "or" 4626 (let ((case-fold-search t)) 4627 (mapconcat 4628 (lambda (x) 4629 (while (string-match name x) 4630 (setq x (replace-match "%s" t t x))) 4631 (if class 4632 (while (string-match class x) 4633 (setq x (replace-match "%s" t t x)))) 4634 x) 4635 (nreverse syntax) 4636 " or "))) 4637 4638(defun idlwave-xml-create-class-method-lists (xml-entry) 4639 ;; Create a class list entry from the xml parsed list., returning a 4640 ;; cons of form (class-entry method-entries). 4641 (let* ((nameblock (nth 1 xml-entry)) 4642 (class (cdr (assq 'name nameblock))) 4643 (link (cdr (assq 'link nameblock))) 4644 (params (cddr xml-entry)) 4645 (case-fold-search t) 4646 class-entry 4647 method methods-entry extra-kwds 4648 props get-props set-props init-props inherits 4649 pelem ptype) 4650 (while params 4651 (setq pelem (car params)) 4652 (when (listp pelem) 4653 (setq ptype (car pelem) 4654 props (car (cdr pelem))) 4655 (cond 4656 ((eq ptype 'SUPERCLASS) 4657 (let ((pname (cdr (assq 'name props))) 4658 (plink (cdr (assq 'link props)))) 4659 (unless (and (string= pname "None") 4660 (string= plink "None")) 4661 (push pname inherits)))) 4662 4663 ((eq ptype 'PROPERTY) 4664 (let ((pname (cdr (assq 'name props))) 4665 (plink (cdr (assq 'link props))) 4666 (get (string= (cdr (assq 'get props)) "Yes")) 4667 (set (string= (cdr (assq 'set props)) "Yes")) 4668 (init (string= (cdr (assq 'init props)) "Yes"))) 4669 (if get (push (list pname plink) get-props)) 4670 (if set (push (list pname plink) set-props)) 4671 (if init (push (list pname plink) init-props)))) 4672 4673 ((eq ptype 'METHOD) 4674 (setq method (cdr (assq 'name props))) 4675 (setq extra-kwds ;;Assume all property keywords are gathered already 4676 (cond 4677 ((string-match (concat class "::Init") method) 4678 (put 'init-props 'matched t) 4679 init-props) 4680 ((string-match (concat class "::GetProperty") method) 4681 (put 'get-props 'matched t) 4682 get-props) 4683 ((string-match (concat class "::SetProperty") method) 4684 (put 'set-props 'matched t) 4685 set-props) 4686 (t nil))) 4687 (setq methods-entry 4688 (nconc (idlwave-xml-create-rinfo-list pelem class extra-kwds) 4689 methods-entry))) 4690 (t))) 4691 (setq params (cdr params))) 4692 ;(unless (get 'init-props 'matched) 4693 ; (message "Failed to match Init in class %s" class)) 4694 ;(unless (get 'get-props 'matched) 4695 ; (message "Failed to match GetProperty in class %s" class)) 4696 ;(unless (get 'set-props 'matched) 4697 ; (message "Failed to match SetProperty in class %s" class)) 4698 (setq class-entry 4699 (if inherits 4700 (list class (append '(inherits) inherits) (list 'link link)) 4701 (list class (list 'link link)))) 4702 (cons class-entry methods-entry))) 4703 4704(defun idlwave-xml-create-rinfo-list (xml-entry &optional class extra-kws) 4705 ;; Create correctly structured list elements from ROUTINE or METHOD 4706 ;; XML list structures. Return a list of list elements, with more 4707 ;; than one sub-list possible if a routine can serve as both 4708 ;; procedure and function (e.g. call_method). 4709 (let* ((nameblock (nth 1 xml-entry)) 4710 (name (cdr (assq 'name nameblock))) 4711 (link (cdr (assq 'link nameblock))) 4712 (params (cddr xml-entry)) 4713 (syntax-vec (make-vector 3 nil)) ; procedure, function, exec command 4714 (case-fold-search t) 4715 syntax kwd klink pref-list kwds pelem ptype entry props result type) 4716 (if class ;; strip out class name from class method name string 4717 (if (string-match (concat class "::") name) 4718 (setq name (substring name (match-end 0))))) 4719 (while params 4720 (setq pelem (car params)) 4721 (when (listp pelem) 4722 (setq ptype (car pelem) 4723 props (car (cdr pelem))) 4724 (cond 4725 ((eq ptype 'SYNTAX) 4726 (setq syntax (cdr (assq 'name props))) 4727 (if (string-match "->" syntax) 4728 (setq syntax (replace-match "->" t nil syntax))) 4729 (setq type (cdr (assq 'type props))) 4730 (push syntax 4731 (aref syntax-vec (cond 4732 ((string-match "^pro" type) 0) 4733 ((string-match "^fun" type) 1) 4734 ((string-match "^exec" type) 2))))) 4735 ((eq ptype 'KEYWORD) 4736 (setq kwd (cdr (assq 'name props)) 4737 klink (cdr (assq 'link props))) 4738 (if (string-match "^\\[XY\\(Z?\\)\\]" kwd) 4739 (progn 4740 (setq pref-list 4741 (if (match-string 1 kwd) '("X" "Y" "Z") '("X" "Y")) 4742 kwd (substring kwd (match-end 0))) 4743 (loop for x in pref-list do 4744 (push (list (concat x kwd) klink) kwds))) 4745 (push (list kwd klink) kwds))) 4746 4747 (t))); Do nothing for the others 4748 (setq params (cdr params))) 4749 4750 ;; Debug 4751; (if (and (null (aref syntax-vec 0)) 4752; (null (aref syntax-vec 1)) 4753; (null (aref syntax-vec 2))) 4754; (with-current-buffer (get-buffer-create "IDL_XML_catalog_complaints") 4755; (if class 4756; (insert (format "Missing SYNTAX entry for %s::%s\n" class name)) 4757; (insert (message "Missing SYNTAX entry for %s\n" name))))) 4758 4759 ;; Executive commands are treated specially 4760 (if (aref syntax-vec 2) 4761 (cons (substring name 1) link) 4762 (if extra-kws (setq kwds (nconc kwds extra-kws))) 4763 (setq kwds (idlwave-rinfo-group-keywords kwds link)) 4764 (loop for idx from 0 to 1 do 4765 (if (aref syntax-vec idx) 4766 (push (append (list name (if (eq idx 0) 'pro 'fun) 4767 class '(system) 4768 (idlwave-shorten-syntax 4769 (aref syntax-vec idx) name class)) 4770 kwds) result))) 4771 result))) 4772 4773 4774(defun idlwave-rinfo-group-keywords (kwds master-link) 4775 ;; Group keywords by link file, as a list with elements 4776 ;; (linkfile ( ("KWD1" . link1) ("KWD2" . link2)) 4777 (let (kwd link anchor linkfiles block master-elt) 4778 (while kwds 4779 (setq kwd (car kwds) 4780 link (idlwave-split-link-target (nth 1 kwd)) 4781 anchor (cdr link) 4782 link (car link) 4783 kwd (car kwd)) 4784 (if (setq block (assoc link linkfiles)) 4785 (push (cons kwd anchor) (cdr block)) 4786 (push (list link (cons kwd anchor)) linkfiles)) 4787 (setq kwds (cdr kwds))) 4788 ;; Ensure the master link is there 4789 (if (setq master-elt (assoc master-link linkfiles)) 4790 (if (eq (car linkfiles) master-elt) 4791 linkfiles 4792 (cons master-elt (delq master-elt linkfiles))) 4793 (push (list master-link) linkfiles)))) 4794 4795(defun idlwave-convert-xml-clean-statement-aliases (aliases) 4796 ;; Clean up the syntax of routines which are actually aliases by 4797 ;; removing the "OR" from the statements 4798 (let (syntax entry) 4799 (loop for x in aliases do 4800 (setq entry (assoc x idlwave-system-routines)) 4801 (when entry 4802 (while (string-match " +or +" (setq syntax (nth 4 entry))) 4803 (setf (nth 4 entry) (replace-match ", " t t syntax))))))) 4804 4805(defun idlwave-convert-xml-clean-routine-aliases (aliases) 4806 ;; Duplicate and trim original routine aliases from rinfo list 4807 ;; This if for, e.g. OPENR/OPENW/OPENU 4808 (let (alias remove-list new parts all-parts) 4809 (loop for x in aliases do 4810 (when (setq parts (split-string (cdr x) "/")) 4811 (setq new (assoc (cdr x) all-parts)) 4812 (unless new 4813 (setq new (cons (cdr x) parts)) 4814 (push new all-parts)) 4815 (setcdr new (delete (car x) (cdr new))))) 4816 4817 ;; Add any missing aliases (separate by slashes) 4818 (loop for x in all-parts do 4819 (if (cdr x) 4820 (push (cons (nth 1 x) (car x)) aliases))) 4821 4822 (loop for x in aliases do 4823 (when (setq alias (assoc (cdr x) idlwave-system-routines)) 4824 (unless (memq alias remove-list) (push alias remove-list)) 4825 (setq alias (copy-sequence alias)) 4826 (setcar alias (car x)) 4827 (push alias idlwave-system-routines))) 4828 (loop for x in remove-list do 4829 (delq x idlwave-system-routines)))) 4830 4831(defun idlwave-convert-xml-clean-sysvar-aliases (aliases) 4832 ;; Duplicate and trim original routine aliases from rinfo list 4833 ;; This if for, e.g. !X, !Y, !Z. 4834 (let (alias remove-list new parts all-parts) 4835 (loop for x in aliases do 4836 (when (setq alias (assoc (cdr x) idlwave-system-variables-alist)) 4837 (unless (memq alias remove-list) (push alias remove-list)) 4838 (setq alias (copy-sequence alias)) 4839 (setcar alias (car x)) 4840 (push alias idlwave-system-variables-alist))) 4841 (loop for x in remove-list do 4842 (delq x idlwave-system-variables-alist)))) 4843 4844 4845(defun idlwave-xml-create-sysvar-alist (xml-entry) 4846 ;; Create a sysvar list entry from the xml parsed list. 4847 (let* ((nameblock (nth 1 xml-entry)) 4848 (name (cdr (assq 'name nameblock))) 4849 (sysvar (substring name (progn (string-match "^ *!" name) 4850 (match-end 0)))) 4851 (link (cdr (assq 'link nameblock))) 4852 (params (cddr xml-entry)) 4853 (case-fold-search t) 4854 pelem ptype props fields tags) 4855 (while params 4856 (setq pelem (car params)) 4857 (when (listp pelem) 4858 (setq ptype (car pelem) 4859 props (car (cdr pelem))) 4860 (cond 4861 ((eq ptype 'FIELD) 4862 (push (cons (cdr (assq 'name props)) 4863 (cdr 4864 (idlwave-split-link-target (cdr (assq 'link props))))) 4865 tags)))) 4866 (setq params (cdr params))) 4867 (delq nil 4868 (list sysvar (if tags (cons 'tags tags)) (list 'link link))))) 4869 4870 4871(defvar idlwave-xml-routine-info-file nil) 4872 4873(defun idlwave-save-routine-info () 4874 (if idlwave-xml-routine-info-file 4875 (with-temp-file idlwave-xml-system-rinfo-converted-file 4876 (insert 4877 (concat ";; *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-* 4878;; IDLWAVE Routine Information File (IDLWAVE version " idlwave-mode-version ") 4879;; Automatically generated from source file: 4880;; " idlwave-xml-routine-info-file " 4881;; on " (current-time-string) " 4882;; Do not edit.")) 4883 (insert (format "\n(setq idlwave-xml-routine-info-file \n \"%s\")" 4884 idlwave-xml-routine-info-file)) 4885 (insert "\n(setq idlwave-system-routines\n '") 4886 (prin1 idlwave-system-routines (current-buffer)) 4887 (insert ")") 4888 (insert "\n(setq idlwave-system-variables-alist\n '") 4889 (prin1 idlwave-system-variables-alist (current-buffer)) 4890 (insert ")") 4891 (insert "\n(setq idlwave-system-class-info\n '") 4892 (prin1 idlwave-system-class-info (current-buffer)) 4893 (insert ")") 4894 (insert "\n(setq idlwave-executive-commands-alist\n '") 4895 (prin1 idlwave-executive-commands-alist (current-buffer)) 4896 (insert ")") 4897 (insert "\n(setq idlwave-help-special-topic-words\n '") 4898 (prin1 idlwave-help-special-topic-words (current-buffer)) 4899 (insert ")")))) 4900 4901(defun idlwave-convert-xml-system-routine-info () 4902 "Convert XML supplied IDL routine info into internal form. 4903Cache to disk for quick recovery." 4904 (interactive) 4905 (let* ((dir (file-name-as-directory 4906 (expand-file-name "help/online_help" (idlwave-sys-dir)))) 4907 (catalog-file (expand-file-name "idl_catalog.xml" dir)) 4908 (elem-cnt 0) 4909 props rinfo msg-cnt elem type nelem class-result alias 4910 routines routine-aliases statement-aliases sysvar-aliases 4911 version-string) 4912 (if (not (file-exists-p catalog-file)) 4913 (error "No such XML routine info file: %s" catalog-file) 4914 (if (not (file-readable-p catalog-file)) 4915 (error "Cannot read XML routine info file: %s" catalog-file))) 4916 (require 'xml) 4917 (message "Reading XML routine info...") 4918 (setq rinfo (xml-parse-file catalog-file)) 4919 (message "Reading XML routine info...done") 4920 (setq rinfo (assq 'CATALOG rinfo)) 4921 (unless rinfo (error "Failed to parse XML routine info")) 4922 ;;(setq rinfo (car rinfo)) ; Skip the catalog stuff. 4923 4924 (setq version-string (cdr (assq 'version (nth 1 rinfo))) 4925 rinfo (cddr rinfo)) 4926 4927 (setq nelem (length rinfo) 4928 msg-cnt (/ nelem 20)) 4929 4930 (setq idlwave-xml-routine-info-file nil) 4931 (message "Converting XML routine info...") 4932 (setq idlwave-system-routines nil 4933 idlwave-system-variables-alist nil 4934 idlwave-system-class-info nil 4935 idlwave-executive-commands-alist nil 4936 idlwave-help-special-topic-words nil) 4937 4938 (while rinfo 4939 (setq elem (car rinfo) 4940 rinfo (cdr rinfo)) 4941 (incf elem-cnt) 4942 (when (listp elem) 4943 (setq type (car elem) 4944 props (car (cdr elem))) 4945 (if (= (mod elem-cnt msg-cnt) 0) 4946 (message "Converting XML routine info...%2d%%" 4947 (/ (* elem-cnt 100) nelem))) 4948 (cond 4949 ((eq type 'ROUTINE) 4950 (if (setq alias (assq 'alias_to props)) 4951 (push (cons (cdr (assq 'name props)) (cdr alias)) 4952 routine-aliases) 4953 (setq routines (idlwave-xml-create-rinfo-list elem)) 4954 (if (listp (cdr routines)) 4955 (setq idlwave-system-routines 4956 (nconc idlwave-system-routines routines)) 4957 ;; a cons cell is an executive commands 4958 (push routines idlwave-executive-commands-alist)))) 4959 4960 ((eq type 'CLASS) 4961 (setq class-result (idlwave-xml-create-class-method-lists elem)) 4962 (push (car class-result) idlwave-system-class-info) 4963 (setq idlwave-system-routines 4964 (nconc idlwave-system-routines (cdr class-result)))) 4965 4966 ((eq type 'STATEMENT) 4967 (push (cons (cdr (assq 'name props)) 4968 (cdr (assq 'link props))) 4969 idlwave-help-special-topic-words) 4970 ;; Save the links to those which are statement aliases (not routines) 4971 (if (setq alias (assq 'alias_to props)) 4972 (unless (member (cdr alias) statement-aliases) 4973 (push (cdr alias) statement-aliases)))) 4974 4975 ((eq type 'SYSVAR) 4976 (if (setq alias (cdr (assq 'alias_to props))) 4977 (push (cons (substring (cdr (assq 'name props)) 1) 4978 (substring alias 1)) 4979 sysvar-aliases) 4980 (push (idlwave-xml-create-sysvar-alist elem) 4981 idlwave-system-variables-alist))) 4982 (t)))) 4983 (idlwave-convert-xml-clean-routine-aliases routine-aliases) 4984 (idlwave-convert-xml-clean-statement-aliases statement-aliases) 4985 (idlwave-convert-xml-clean-sysvar-aliases sysvar-aliases) 4986 4987 (setq idlwave-xml-routine-info-file catalog-file) 4988 (idlwave-save-routine-info) 4989 (message "Converting XML routine info...done"))) 4990 4991 4992;; ("ROUTINE" type class 4993;; (system) | (lib pro_file dir "LIBNAME") | (user pro_file dir "USERLIB") | 4994;; (buffer pro_file dir) | (compiled pro_file dir) 4995;; "calling_string" ("HELPFILE" (("KWD1" . link1) ...)) 4996;; ("HELPFILE2" (("KWD2" . link) ...)) ...) 4997 4998 4999(defun idlwave-load-rinfo-next-step () 5000 (let ((inhibit-quit t) 5001 (arr idlwave-load-rinfo-steps-done)) 5002 (if (catch 'exit 5003 (when (not (aref arr 0)) 5004 (message "Loading system routine info in idle time...") 5005 (idlwave-load-system-routine-info) 5006 ;;(load "idlw-rinfo" 'noerror 'nomessage) 5007 (message "Loading system routine info in idle time...done") 5008 (aset arr 0 t) 5009 (throw 'exit t)) 5010 5011 (when (not (aref arr 1)) 5012 (message "Normalizing idlwave-system-routines in idle time...") 5013 (idlwave-reset-sintern t) 5014 (put 'idlwave-reset-sintern 'done-by-idle t) 5015 (setq idlwave-system-routines 5016 (idlwave-sintern-rinfo-list idlwave-system-routines 'sys)) 5017 (message "Normalizing idlwave-system-routines in idle time...done") 5018 (aset arr 1 t) 5019 (throw 'exit t)) 5020 5021 (when (not (aref arr 2)) 5022 (when (and (stringp idlwave-user-catalog-file) 5023 (file-regular-p idlwave-user-catalog-file)) 5024 (message "Loading user catalog in idle time...") 5025 (condition-case nil 5026 (load-file idlwave-user-catalog-file) 5027 (error (throw 'exit nil))) 5028 ;; Check for the old style catalog and warn 5029 (if (and 5030 (boundp 'idlwave-library-routines) 5031 idlwave-library-routines) 5032 (progn 5033 (setq idlwave-library-routines nil) 5034 (ding) 5035 (message "Outdated user catalog: %s... recreate" 5036 idlwave-user-catalog-file)) 5037 (message "Loading user catalog in idle time...done"))) 5038 (aset arr 2 t) 5039 (throw 'exit t)) 5040 5041 (when (not (aref arr 3)) 5042 (when idlwave-user-catalog-routines 5043 (message "Normalizing user catalog routines in idle time...") 5044 (setq idlwave-user-catalog-routines 5045 (idlwave-sintern-rinfo-list 5046 idlwave-user-catalog-routines 'sys)) 5047 (message 5048 "Normalizing user catalog routines in idle time...done")) 5049 (aset arr 3 t) 5050 (throw 'exit t)) 5051 5052 (when (not (aref arr 4)) 5053 (idlwave-scan-library-catalogs 5054 "Loading and normalizing library catalogs in idle time...") 5055 (aset arr 4 t) 5056 (throw 'exit t)) 5057 (when (not (aref arr 5)) 5058 (message "Finishing initialization in idle time...") 5059 (idlwave-routines) 5060 (message "Finishing initialization in idle time...done") 5061 (aset arr 5 t) 5062 (throw 'exit nil))) 5063 ;; restart the timer 5064 (if (sit-for 1) 5065 (idlwave-load-rinfo-next-step) 5066 (setq idlwave-load-rinfo-idle-timer 5067 (run-with-idle-timer 5068 idlwave-init-rinfo-when-idle-after 5069 nil 'idlwave-load-rinfo-next-step)))))) 5070 5071(defun idlwave-load-all-rinfo (&optional force) 5072 ;; Load and case-treat the system, user catalog, and library routine 5073 ;; info files. 5074 5075 ;; System 5076 (when (or force (not (aref idlwave-load-rinfo-steps-done 0))) 5077 ;;(load "idlw-rinfo" 'noerror 'nomessage)) 5078 (idlwave-load-system-routine-info)) 5079 (when (or force (not (aref idlwave-load-rinfo-steps-done 1))) 5080 (message "Normalizing idlwave-system-routines...") 5081 (setq idlwave-system-routines 5082 (idlwave-sintern-rinfo-list idlwave-system-routines 'sys)) 5083 (message "Normalizing idlwave-system-routines...done")) 5084 (when idlwave-system-routines 5085 (setq idlwave-routines (copy-sequence idlwave-system-routines)) 5086 (setq idlwave-last-system-routine-info-cons-cell 5087 (nthcdr (1- (length idlwave-routines)) idlwave-routines))) 5088 5089 ;; User catalog 5090 (when (and (stringp idlwave-user-catalog-file) 5091 (file-regular-p idlwave-user-catalog-file)) 5092 (condition-case nil 5093 (when (or force (not (aref idlwave-load-rinfo-steps-done 2))) 5094 (load-file idlwave-user-catalog-file)) 5095 (error nil)) 5096 (when (and 5097 (boundp 'idlwave-library-routines) 5098 idlwave-library-routines) 5099 (setq idlwave-library-routines nil) 5100 (error "Outdated user catalog: %s... recreate" 5101 idlwave-user-catalog-file)) 5102 (setq idlwave-true-path-alist nil) 5103 (when (or force (not (aref idlwave-load-rinfo-steps-done 3))) 5104 (message "Normalizing user catalog routines...") 5105 (setq idlwave-user-catalog-routines 5106 (idlwave-sintern-rinfo-list 5107 idlwave-user-catalog-routines 'sys)) 5108 (message "Normalizing user catalog routines...done"))) 5109 5110 ;; Library catalog 5111 (when (or force (not (aref idlwave-load-rinfo-steps-done 4))) 5112 (idlwave-scan-library-catalogs 5113 "Loading and normalizing library catalogs...")) 5114 (run-hooks 'idlwave-after-load-rinfo-hook)) 5115 5116 5117(defun idlwave-update-buffer-routine-info () 5118 (let (res) 5119 (cond 5120 ((eq idlwave-scan-all-buffers-for-routine-info t) 5121 ;; Scan all buffers, current buffer last 5122 (message "Scanning all buffers...") 5123 (setq res (idlwave-get-routine-info-from-buffers 5124 (reverse (buffer-list))))) 5125 ((null idlwave-scan-all-buffers-for-routine-info) 5126 ;; Don't scan any buffers 5127 (setq res nil)) 5128 (t 5129 ;; Just scan this buffer 5130 (if (eq major-mode 'idlwave-mode) 5131 (progn 5132 (message "Scanning current buffer...") 5133 (setq res (idlwave-get-routine-info-from-buffers 5134 (list (current-buffer)))))))) 5135 ;; Put the result into the correct variable 5136 (setq idlwave-buffer-routines 5137 (idlwave-sintern-rinfo-list res 'set)))) 5138 5139(defun idlwave-concatenate-rinfo-lists (&optional quiet run-hook) 5140 "Put the different sources for routine information together." 5141 ;; The sequence here is important because earlier definitions shadow 5142 ;; later ones. We assume that if things in the buffers are newer 5143 ;; then in the shell of the system, they are meant to be different. 5144 (setcdr idlwave-last-system-routine-info-cons-cell 5145 (append idlwave-buffer-routines 5146 idlwave-compiled-routines 5147 idlwave-library-catalog-routines 5148 idlwave-user-catalog-routines)) 5149 (setq idlwave-class-alist nil) 5150 5151 ;; Give a message with information about the number of routines we have. 5152 (unless quiet 5153 (message 5154 "Routines Found: buffer(%d) compiled(%d) library(%d) user(%d) system(%d)" 5155 (length idlwave-buffer-routines) 5156 (length idlwave-compiled-routines) 5157 (length idlwave-library-catalog-routines) 5158 (length idlwave-user-catalog-routines) 5159 (length idlwave-system-routines))) 5160 (if run-hook 5161 (run-hooks 'idlwave-update-rinfo-hook))) 5162 5163(defun idlwave-class-alist () 5164 "Return the class alist - make it if necessary." 5165 (or idlwave-class-alist 5166 (let (class) 5167 (loop for x in idlwave-routines do 5168 (when (and (setq class (nth 2 x)) 5169 (not (assq class idlwave-class-alist))) 5170 (push (list class) idlwave-class-alist))) 5171 idlwave-class-alist))) 5172 5173;; Three functions for the hooks 5174(defun idlwave-save-buffer-update () 5175 (idlwave-update-current-buffer-info 'save-buffer)) 5176(defun idlwave-kill-buffer-update () 5177 (idlwave-update-current-buffer-info 'kill-buffer)) 5178(defun idlwave-new-buffer-update () 5179 (idlwave-update-current-buffer-info 'find-file)) 5180 5181(defun idlwave-update-current-buffer-info (why) 5182 "Update idlwave-routines for current buffer. Can run from after-save-hook." 5183 (when (and (eq major-mode 'idlwave-mode) 5184 (or (eq t idlwave-auto-routine-info-updates) 5185 (memq why idlwave-auto-routine-info-updates)) 5186 idlwave-scan-all-buffers-for-routine-info 5187 idlwave-routines) 5188 (condition-case nil 5189 (let (routines) 5190 (idlwave-replace-buffer-routine-info 5191 (buffer-file-name) 5192 (if (eq why 'kill-buffer) 5193 nil 5194 (setq routines 5195 (idlwave-sintern-rinfo-list 5196 (idlwave-get-routine-info-from-buffers 5197 (list (current-buffer))) 'set)))) 5198 (idlwave-concatenate-rinfo-lists 'quiet) 5199 routines) 5200 (error nil)))) 5201 5202(defun idlwave-replace-buffer-routine-info (file new) 5203 "Cut the part from FILE out of `idlwave-buffer-routines' and add NEW." 5204 (let ((list idlwave-buffer-routines) 5205 found) 5206 (while list 5207 ;; The following test uses eq to make sure it works correctly 5208 ;; when two buffers visit the same file. Then the file names 5209 ;; will be equal, but not eq. 5210 (if (eq (idlwave-routine-source-file (nth 3 (car list))) file) 5211 (progn 5212 (setcar list nil) 5213 (setq found t)) 5214 (if found 5215 ;; End of that section reached. Jump. 5216 (setq list nil))) 5217 (setq list (cdr list))) 5218 (setq idlwave-buffer-routines 5219 (append new (delq nil idlwave-buffer-routines))))) 5220 5221;;----- Scanning buffers ------------------- 5222 5223(defun idlwave-get-routine-info-from-buffers (buffers) 5224 "Call `idlwave-get-buffer-routine-info' on idlwave-mode buffers in BUFFERS." 5225 (let (buf routine-lists res) 5226 (save-excursion 5227 (while (setq buf (pop buffers)) 5228 (set-buffer buf) 5229 (if (and (eq major-mode 'idlwave-mode) 5230 buffer-file-name) 5231 ;; yes, this buffer has the right mode. 5232 (progn (setq res (condition-case nil 5233 (idlwave-get-buffer-routine-info) 5234 (error nil))) 5235 (push res routine-lists))))) 5236 ;; Concatenate the individual lists and return the result 5237 (apply 'nconc routine-lists))) 5238 5239(defun idlwave-get-buffer-routine-info () 5240 "Scan the current buffer for routine info. Return (PRO-LIST FUNC-LIST)." 5241 (let* ((case-fold-search t) 5242 routine-list string entry) 5243 (save-excursion 5244 (save-restriction 5245 (widen) 5246 (goto-char (point-min)) 5247 (while (re-search-forward 5248 "^[ \t]*\\(pro\\|function\\)[ \t]" nil t) 5249 (setq string (buffer-substring-no-properties 5250 (match-beginning 0) 5251 (progn 5252 (idlwave-end-of-statement) 5253 (point)))) 5254 (setq entry (idlwave-parse-definition string)) 5255 (push entry routine-list)))) 5256 routine-list)) 5257 5258(defvar idlwave-scanning-lib-dir) 5259(defun idlwave-parse-definition (string) 5260 "Parse a module definition." 5261 (let ((case-fold-search t) 5262 start name args type keywords class) 5263 ;; Remove comments 5264 (while (string-match ";.*" string) 5265 (setq string (replace-match "" t t string))) 5266 ;; Remove the continuation line stuff 5267 (while (string-match "\\([^a-zA-Z0-9$_]\\)\\$[ \t]*\n" string) 5268 (setq string (replace-match "\\1 " t nil string))) 5269 (while (string-match "\n" string) 5270 (setq string (replace-match " " t nil string))) 5271 ;; Match the name and type. 5272 (when (string-match 5273 "\\<\\(pro\\|function\\)\\>\\s-+\\(\\([a-zA-Z0-9$_]+\\)::\\)?\\([a-zA-Z0-9$_]+\\)" string) 5274 (setq start (match-end 0)) 5275 (setq type (downcase (match-string 1 string))) 5276 (if (match-beginning 3) 5277 (setq class (match-string 3 string))) 5278 (setq name (match-string 4 string))) 5279 ;; Match normal args and keyword args 5280 (while (string-match 5281 ",\\s-*\\([a-zA-Z][a-zA-Z0-9$_]*\\|\\(_ref\\)?_extra\\)\\s-*\\(=\\)?" 5282 string start) 5283 (setq start (match-end 0)) 5284 (if (match-beginning 3) 5285 (push (match-string 1 string) keywords) 5286 (push (match-string 1 string) args))) 5287 ;; Normalize and sort. 5288 (setq args (nreverse args)) 5289 (setq keywords (sort keywords (lambda (a b) 5290 (string< (downcase a) (downcase b))))) 5291 ;; Make and return the entry 5292 ;; We don't know which argument are optional, so this information 5293 ;; will not be contained in the calling sequence. 5294 (list name 5295 (if (equal type "pro") 'pro 'fun) 5296 class 5297 (cond ((not (boundp 'idlwave-scanning-lib)) 5298 (list 'buffer (buffer-file-name))) 5299; ((string= (downcase 5300; (file-name-sans-extension 5301; (file-name-nondirectory (buffer-file-name)))) 5302; (downcase name)) 5303; (list 'lib)) 5304; (t (cons 'lib (file-name-nondirectory (buffer-file-name)))) 5305 (t (list 'user (file-name-nondirectory (buffer-file-name)) 5306 idlwave-scanning-lib-dir "UserLib"))) 5307 (concat 5308 (if (string= type "function") "Result = " "") 5309 (if class "Obj ->[%s::]" "") 5310 "%s" 5311 (if args 5312 (concat 5313 (if (string= type "function") "(" ", ") 5314 (mapconcat 'identity args ", ") 5315 (if (string= type "function") ")" "")))) 5316 (if keywords 5317 (cons nil (mapcar 'list keywords)) ;No help file 5318 nil)))) 5319 5320 5321;;----- Scanning the user catalog ------------------- 5322 5323(defun idlwave-sys-dir () 5324 "Return the syslib directory, or a dummy that never matches." 5325 (cond 5326 ((and idlwave-system-directory 5327 (not (string= idlwave-system-directory ""))) 5328 idlwave-system-directory) 5329 ((getenv "IDL_DIR")) 5330 (t "@@@@@@@@"))) 5331 5332 5333(defun idlwave-create-user-catalog-file (&optional arg) 5334 "Scan all files on selected dirs of IDL search path for routine information. 5335 5336A widget checklist will allow you to choose the directories. Write 5337the result as a file `idlwave-user-catalog-file'. When this file 5338exists, will be automatically loaded to give routine information about 5339library routines. With ARG, just rescan the same directories as last 5340time - so no widget will pop up." 5341 (interactive "P") 5342 ;; Make sure the file is loaded if it exists. 5343 (if (and (stringp idlwave-user-catalog-file) 5344 (file-regular-p idlwave-user-catalog-file)) 5345 (condition-case nil 5346 (load-file idlwave-user-catalog-file) 5347 (error nil))) 5348 ;; Make sure the file name makes sense 5349 (unless (and (stringp idlwave-user-catalog-file) 5350 (> (length idlwave-user-catalog-file) 0) 5351 (file-accessible-directory-p 5352 (file-name-directory idlwave-user-catalog-file)) 5353 (not (string= "" (file-name-nondirectory 5354 idlwave-user-catalog-file)))) 5355 (error "`idlwave-user-catalog-file' does not point to a file in an accessible directory")) 5356 5357 (cond 5358 ;; Rescan the known directories 5359 ((and arg idlwave-path-alist 5360 (consp (car idlwave-path-alist))) 5361 (idlwave-scan-user-lib-files idlwave-path-alist)) 5362 5363 ;; Expand the directories from library-path and run the widget 5364 (idlwave-library-path 5365 (idlwave-display-user-catalog-widget 5366 (if idlwave-true-path-alist 5367 ;; Propagate any flags on the existing path-alist 5368 (mapcar (lambda (x) 5369 (let ((path-entry (assoc (file-truename x) 5370 idlwave-true-path-alist))) 5371 (if path-entry 5372 (cons x (cdr path-entry)) 5373 (list x)))) 5374 (idlwave-expand-path idlwave-library-path)) 5375 (mapcar 'list (idlwave-expand-path idlwave-library-path))))) 5376 5377 ;; Ask the shell for the path and then run the widget 5378 (t 5379 (message "Asking the shell for IDL path...") 5380 (require 'idlw-shell) 5381 (idlwave-shell-send-command idlwave-shell-path-query 5382 '(idlwave-user-catalog-command-hook nil) 5383 'hide)))) 5384 5385 5386;; Parse shell path information and select among it. 5387(defun idlwave-user-catalog-command-hook (&optional arg) 5388 ;; Command hook used by `idlwave-create-user-catalog-file'. 5389 (if arg 5390 ;; Scan immediately 5391 (idlwave-scan-user-lib-files idlwave-path-alist) 5392 ;; Set the path and display the widget 5393 (idlwave-shell-get-path-info 'no-write) ; set to something path-alist 5394 (idlwave-scan-library-catalogs "Locating library catalogs..." 'no-load) 5395 (idlwave-display-user-catalog-widget idlwave-path-alist))) 5396 5397(defconst idlwave-user-catalog-widget-help-string 5398 "This is the front-end to the creation of the IDLWAVE user catalog. 5399Please select the directories on IDL's search path from which you 5400would like to extract routine information, to be stored in the file: 5401 5402 %s 5403 5404If this is not the correct file, first set variable 5405`idlwave-user-catalog-file', and call this command again. 5406 5407N.B. Many libraries include pre-scanned catalog files 5408\(\".idlwave_catalog\"). These are marked with \"[LIB]\", and need 5409not be scanned. You can scan your own libraries off-line using the 5410perl script `idlwave_catalog'. 5411 5412After selecting the directories, choose [Scan & Save] to scan the library 5413directories and save the routine info. 5414\n") 5415 5416(defvar idlwave-widget) 5417(defvar widget-keymap) 5418(defun idlwave-display-user-catalog-widget (dirs-list) 5419 "Create the widget to select IDL search path directories for scanning." 5420 (interactive) 5421 (require 'widget) 5422 (require 'wid-edit) 5423 (unless dirs-list 5424 (error "Don't know IDL's search path")) 5425 5426 (kill-buffer (get-buffer-create "*IDLWAVE Widget*")) 5427 (switch-to-buffer (get-buffer-create "*IDLWAVE Widget*")) 5428 (kill-all-local-variables) 5429 (make-local-variable 'idlwave-widget) 5430 (widget-insert (format idlwave-user-catalog-widget-help-string 5431 idlwave-user-catalog-file)) 5432 5433 (widget-create 'push-button 5434 :notify 'idlwave-widget-scan-user-lib-files 5435 "Scan & Save") 5436 (widget-insert " ") 5437 (widget-create 'push-button 5438 :notify 'idlwave-delete-user-catalog-file 5439 "Delete File") 5440 (widget-insert " ") 5441 (widget-create 'push-button 5442 :notify 5443 '(lambda (&rest ignore) 5444 (let ((path-list (widget-get idlwave-widget :path-dirs))) 5445 (mapcar (lambda (x) 5446 (unless (memq 'lib (cdr x)) 5447 (idlwave-path-alist-add-flag x 'user))) 5448 path-list) 5449 (idlwave-display-user-catalog-widget path-list))) 5450 "Select All Non-Lib") 5451 (widget-insert " ") 5452 (widget-create 'push-button 5453 :notify 5454 '(lambda (&rest ignore) 5455 (let ((path-list (widget-get idlwave-widget :path-dirs))) 5456 (mapcar (lambda (x) 5457 (idlwave-path-alist-remove-flag x 'user)) 5458 path-list) 5459 (idlwave-display-user-catalog-widget path-list))) 5460 "Deselect All") 5461 (widget-insert " ") 5462 (widget-create 'push-button 5463 :notify (lambda (&rest ignore) 5464 (kill-buffer (current-buffer))) 5465 "Quit") 5466 (widget-insert "\n\n") 5467 5468 (widget-insert "Select Directories: \n") 5469 5470 (setq idlwave-widget 5471 (apply 'widget-create 5472 'checklist 5473 :value (delq nil (mapcar (lambda (x) 5474 (if (memq 'user (cdr x)) 5475 (car x))) 5476 dirs-list)) 5477 :greedy t 5478 :tag "List of directories" 5479 (mapcar (lambda (x) 5480 (list 'item 5481 (if (memq 'lib (cdr x)) 5482 (concat "[LIB] " (car x) ) 5483 (car x)))) dirs-list))) 5484 (widget-put idlwave-widget :path-dirs dirs-list) 5485 (widget-insert "\n") 5486 (use-local-map widget-keymap) 5487 (widget-setup) 5488 (goto-char (point-min)) 5489 (delete-other-windows)) 5490 5491(defun idlwave-delete-user-catalog-file (&rest ignore) 5492 (if (yes-or-no-p 5493 (format "Delete file %s " idlwave-user-catalog-file)) 5494 (progn 5495 (delete-file idlwave-user-catalog-file) 5496 (message "%s has been deleted" idlwave-user-catalog-file)))) 5497 5498(defun idlwave-widget-scan-user-lib-files (&rest ignore) 5499 ;; Call `idlwave-scan-user-lib-files' with data taken from the widget. 5500 (let* ((widget idlwave-widget) 5501 (selected-dirs (widget-value widget)) 5502 (path-alist (widget-get widget :path-dirs)) 5503 (this-path-alist path-alist) 5504 dir-entry) 5505 (while (setq dir-entry (pop this-path-alist)) 5506 (if (member 5507 (if (memq 'lib (cdr dir-entry)) 5508 (concat "[LIB] " (car dir-entry)) 5509 (car dir-entry)) 5510 selected-dirs) 5511 (idlwave-path-alist-add-flag dir-entry 'user) 5512 (idlwave-path-alist-remove-flag dir-entry 'user))) 5513 (idlwave-scan-user-lib-files path-alist))) 5514 5515(defvar font-lock-mode) 5516(defun idlwave-scan-user-lib-files (path-alist) 5517 ;; Scan the PRO files in PATH-ALIST and store the info in the user catalog 5518 (let* ((idlwave-scanning-lib t) 5519 (idlwave-scanning-lib-dir "") 5520 (idlwave-completion-case nil) 5521 dirs-alist dir files file) 5522 (setq idlwave-user-catalog-routines nil 5523 idlwave-path-alist path-alist ; for library-path instead 5524 idlwave-true-path-alist nil) 5525 (if idlwave-auto-write-paths (idlwave-write-paths)) 5526 (save-excursion 5527 (set-buffer (get-buffer-create "*idlwave-scan.pro*")) 5528 (idlwave-mode) 5529 (setq dirs-alist (reverse path-alist)) 5530 (while (setq dir (pop dirs-alist)) 5531 (when (memq 'user (cdr dir)) ; Has it marked for scan? 5532 (setq dir (car dir)) 5533 (setq idlwave-scanning-lib-dir dir) 5534 (when (file-directory-p dir) 5535 (setq files (directory-files dir 'full "\\.[pP][rR][oO]\\'")) 5536 (while (setq file (pop files)) 5537 (when (file-regular-p file) 5538 (if (not (file-readable-p file)) 5539 (message "Skipping %s (no read permission)" file) 5540 (message "Scanning %s..." file) 5541 (erase-buffer) 5542 (insert-file-contents file 'visit) 5543 (setq idlwave-user-catalog-routines 5544 (append (idlwave-get-routine-info-from-buffers 5545 (list (current-buffer))) 5546 idlwave-user-catalog-routines))))))))) 5547 (message "Creating user catalog file...") 5548 (kill-buffer "*idlwave-scan.pro*") 5549 (kill-buffer (get-buffer-create "*IDLWAVE Widget*")) 5550 (let ((font-lock-maximum-size 0) 5551 (auto-mode-alist nil)) 5552 (find-file idlwave-user-catalog-file)) 5553 (if (and (boundp 'font-lock-mode) 5554 font-lock-mode) 5555 (font-lock-mode 0)) 5556 (erase-buffer) 5557 (insert ";; IDLWAVE user catalog file\n") 5558 (insert (format ";; Created %s\n\n" (current-time-string))) 5559 5560 ;; Define the routine info list 5561 (insert "\n(setq idlwave-user-catalog-routines\n '(") 5562 (let ((standard-output (current-buffer))) 5563 (mapcar (lambda (x) 5564 (insert "\n ") 5565 (prin1 x) 5566 (goto-char (point-max))) 5567 idlwave-user-catalog-routines)) 5568 (insert (format "))\n\n;;; %s ends here\n" 5569 (file-name-nondirectory idlwave-user-catalog-file))) 5570 (goto-char (point-min)) 5571 ;; Save the buffer 5572 (save-buffer 0) 5573 (kill-buffer (current-buffer))) 5574 (message "Creating user catalog file...done") 5575 (message "Info for %d routines saved in %s" 5576 (length idlwave-user-catalog-routines) 5577 idlwave-user-catalog-file) 5578 (sit-for 2) 5579 (idlwave-update-routine-info t)) 5580 5581(defun idlwave-read-paths () 5582 (if (and (stringp idlwave-path-file) 5583 (file-regular-p idlwave-path-file)) 5584 (condition-case nil 5585 (load idlwave-path-file t t t) 5586 (error nil)))) 5587 5588(defun idlwave-write-paths () 5589 (interactive) 5590 (when (and idlwave-path-alist idlwave-system-directory) 5591 (let ((font-lock-maximum-size 0) 5592 (auto-mode-alist nil)) 5593 (find-file idlwave-path-file)) 5594 (if (and (boundp 'font-lock-mode) 5595 font-lock-mode) 5596 (font-lock-mode 0)) 5597 (erase-buffer) 5598 (insert ";; IDLWAVE paths\n") 5599 (insert (format ";; Created %s\n\n" (current-time-string))) 5600 ;; Define the variable which knows the value of "!DIR" 5601 (insert (format "\n(setq idlwave-system-directory \"%s\")\n" 5602 idlwave-system-directory)) 5603 5604 ;; Define the variable which contains a list of all scanned directories 5605 (insert "\n(setq idlwave-path-alist\n '(") 5606 (let ((standard-output (current-buffer))) 5607 (mapcar (lambda (x) 5608 (insert "\n ") 5609 (prin1 x) 5610 (goto-char (point-max))) 5611 idlwave-path-alist)) 5612 (insert "))\n") 5613 (save-buffer 0) 5614 (kill-buffer (current-buffer)))) 5615 5616 5617(defun idlwave-expand-path (path &optional default-dir) 5618 ;; Expand parts of path starting with '+' recursively into directory list. 5619 ;; Relative recursive path elements are expanded relative to DEFAULT-DIR. 5620 (message "Expanding path...") 5621 (let (path1 dir recursive) 5622 (while (setq dir (pop path)) 5623 (if (setq recursive (string= (substring dir 0 1) "+")) 5624 (setq dir (substring dir 1))) 5625 (if (and recursive 5626 (not (file-name-absolute-p dir))) 5627 (setq dir (expand-file-name dir default-dir))) 5628 (if recursive 5629 ;; Expand recursively 5630 (setq path1 (append (idlwave-recursive-directory-list dir) path1)) 5631 ;; Keep unchanged 5632 (push dir path1))) 5633 (message "Expanding path...done") 5634 (nreverse path1))) 5635 5636(defun idlwave-recursive-directory-list (dir) 5637 ;; Return a list of all directories below DIR, including DIR itself 5638 (let ((path (list dir)) path1 file files) 5639 (while (setq dir (pop path)) 5640 (when (file-directory-p dir) 5641 (setq files (nreverse (directory-files dir t "[^.]"))) 5642 (while (setq file (pop files)) 5643 (if (file-directory-p file) 5644 (push (file-name-as-directory file) path))) 5645 (push dir path1))) 5646 path1)) 5647 5648 5649;;----- Scanning the library catalogs ------------------ 5650 5651 5652 5653 5654(defun idlwave-scan-library-catalogs (&optional message-base no-load) 5655 "Scan for library catalog files (.idlwave_catalog) and ingest. 5656 5657All directories on `idlwave-path-alist' (or `idlwave-library-path' 5658instead, if present) are searched. Print MESSAGE-BASE along with the 5659libraries being loaded, if passed, and skip loading/normalizing if 5660NO-LOAD is non-nil. The variable `idlwave-use-library-catalogs' can 5661be set to nil to disable library catalog scanning." 5662 (when idlwave-use-library-catalogs 5663 (let ((dirs 5664 (if idlwave-library-path 5665 (idlwave-expand-path idlwave-library-path) 5666 (mapcar 'car idlwave-path-alist))) 5667 (old-libname "") 5668 dir-entry dir flags catalog all-routines) 5669 (if message-base (message message-base)) 5670 (while (setq dir (pop dirs)) 5671 (catch 'continue 5672 (when (file-readable-p 5673 (setq catalog (expand-file-name ".idlwave_catalog" dir))) 5674 (unless no-load 5675 (setq idlwave-library-catalog-routines nil) 5676 ;; Load the catalog file 5677 (condition-case nil 5678 (load catalog t t t) 5679 (error (throw 'continue t))) 5680 (when (and 5681 message-base 5682 (not (string= idlwave-library-catalog-libname 5683 old-libname))) 5684 (message "%s" (concat message-base 5685 idlwave-library-catalog-libname)) 5686 (setq old-libname idlwave-library-catalog-libname)) 5687 (when idlwave-library-catalog-routines 5688 (setq all-routines 5689 (append 5690 (idlwave-sintern-rinfo-list 5691 idlwave-library-catalog-routines 'sys dir) 5692 all-routines)))) 5693 5694 ;; Add a 'lib flag if on path-alist 5695 (when (and idlwave-path-alist 5696 (setq dir-entry (assoc dir idlwave-path-alist))) 5697 (idlwave-path-alist-add-flag dir-entry 'lib))))) 5698 (unless no-load (setq idlwave-library-catalog-routines all-routines)) 5699 (if message-base (message (concat message-base "done")))))) 5700 5701;;----- Communicating with the Shell ------------------- 5702 5703;; First, here is the idl program which can be used to query IDL for 5704;; defined routines. 5705(defconst idlwave-routine-info.pro 5706 " 5707;; START OF IDLWAVE SUPPORT ROUTINES 5708pro idlwave_print_safe,item,limit 5709 catch,err 5710 if err ne 0 then begin 5711 print,'Could not print item.' 5712 return 5713 endif 5714 if n_elements(item) gt limit then $ 5715 print,item[0:limit-1],'<... truncated at ',strtrim(limit,2),' elements>' $ 5716 else print,item 5717end 5718 5719pro idlwave_print_info_entry,name,func=func,separator=sep 5720 ;; See if it's an object method 5721 if name eq '' then return 5722 func = keyword_set(func) 5723 methsep = strpos(name,'::') 5724 meth = methsep ne -1 5725 5726 ;; Get routine info 5727 pars = routine_info(name,/parameters,functions=func) 5728 source = routine_info(name,/source,functions=func) 5729 nargs = pars.num_args 5730 nkw = pars.num_kw_args 5731 if nargs gt 0 then args = pars.args 5732 if nkw gt 0 then kwargs = pars.kw_args 5733 5734 ;; Trim the class, and make the name 5735 if meth then begin 5736 class = strmid(name,0,methsep) 5737 name = strmid(name,methsep+2,strlen(name)-1) 5738 if nargs gt 0 then begin 5739 ;; remove the self argument 5740 wh = where(args ne 'SELF',nargs) 5741 if nargs gt 0 then args = args[wh] 5742 endif 5743 endif else begin 5744 ;; No class, just a normal routine. 5745 class = \"\" 5746 endelse 5747 5748 ;; Calling sequence 5749 cs = \"\" 5750 if func then cs = 'Result = ' 5751 if meth then cs = cs + 'Obj -> [' + '%s' + '::]' 5752 cs = cs + '%s' 5753 if func then cs = cs + '(' else if nargs gt 0 then cs = cs + ', ' 5754 if nargs gt 0 then begin 5755 for j=0,nargs-1 do begin 5756 cs = cs + args[j] 5757 if j lt nargs-1 then cs = cs + ', ' 5758 endfor 5759 end 5760 if func then cs = cs + ')' 5761 ;; Keyword arguments 5762 kwstring = '' 5763 if nkw gt 0 then begin 5764 for j=0,nkw-1 do begin 5765 kwstring = kwstring + ' ' + kwargs[j] 5766 endfor 5767 endif 5768 5769 ret=(['IDLWAVE-PRO','IDLWAVE-FUN'])[func] 5770 5771 print,ret + ': ' + name + sep + class + sep + source[0].path $ 5772 + sep + cs + sep + kwstring 5773end 5774 5775pro idlwave_routine_info,file 5776 on_error,1 5777 sep = '<@>' 5778 print,'>>>BEGIN OF IDLWAVE ROUTINE INFO (\"' + sep + '\" IS THE SEPARATOR)' 5779 all = routine_info() 5780 fileQ=n_elements(file) ne 0 5781 if fileQ then file=strtrim(file,2) 5782 for i=0L,n_elements(all)-1L do begin 5783 if fileQ then begin 5784 if (routine_info(all[i],/SOURCE)).path eq file then $ 5785 idlwave_print_info_entry,all[i],separator=sep 5786 endif else idlwave_print_info_entry,all[i],separator=sep 5787 endfor 5788 all = routine_info(/functions) 5789 for i=0L,n_elements(all)-1L do begin 5790 if fileQ then begin 5791 if (routine_info(all[i],/FUNCTIONS,/SOURCE)).path eq file then $ 5792 idlwave_print_info_entry,all[i],separator=sep,/FUNC 5793 endif else idlwave_print_info_entry,all[i],separator=sep,/FUNC 5794 endfor 5795 print,'>>>END OF IDLWAVE ROUTINE INFO' 5796end 5797 5798pro idlwave_get_sysvars 5799 on_error,1 5800 catch,error_status 5801 if error_status ne 0 then begin 5802 print, 'Cannot get info about system variables' 5803 endif else begin 5804 help,/brief,output=s,/system_variables ; ? unsafe use of OUTPUT= 5805 s = strtrim(strjoin(s,' ',/single),2) ; make one line 5806 v = strsplit(s,' +',/regex,/extract) ; get variables 5807 for i=0L,n_elements(v)-1 do begin 5808 t = [''] ; get tag list 5809 a=execute('if n_tags('+v[i]+') gt 0 then t=tag_names('+v[i]+')') 5810 print, 'IDLWAVE-SYSVAR: '+v[i]+' '+strjoin(t,' ',/single) 5811 endfor 5812 endelse 5813end 5814 5815pro idlwave_get_class_tags, class 5816 res = execute('tags=tag_names({'+class+'})') 5817 if res then print,'IDLWAVE-CLASS-TAGS: '+class+' '+strjoin(tags,' ',/single) 5818end 5819;; END OF IDLWAVE SUPPORT ROUTINES 5820" 5821 "The idl programs to get info from the shell.") 5822 5823(defvar idlwave-idlwave_routine_info-compiled nil 5824 "Remembers if the routine info procedure is already compiled.") 5825 5826(defvar idlwave-shell-temp-pro-file) 5827(defvar idlwave-shell-temp-rinfo-save-file) 5828 5829(defun idlwave-shell-compile-helper-routines (&optional wait) 5830 (unless (and idlwave-idlwave_routine_info-compiled 5831 (file-readable-p (idlwave-shell-temp-file 'rinfo))) 5832 (save-excursion 5833 (set-buffer (idlwave-find-file-noselect 5834 (idlwave-shell-temp-file 'pro))) 5835 (erase-buffer) 5836 (insert idlwave-routine-info.pro) 5837 (save-buffer 0)) 5838 (idlwave-shell-send-command 5839 (concat ".run \"" idlwave-shell-temp-pro-file "\"") 5840 nil 'hide wait) 5841 (idlwave-shell-send-command 5842 (format "save,'idlwave_print_safe','idlwave_routine_info','idlwave_print_info_entry','idlwave_get_class_tags','idlwave_get_sysvars',FILE='%s',/ROUTINES" 5843 (idlwave-shell-temp-file 'rinfo)) 5844 nil 'hide) 5845 (setq idlwave-idlwave_routine_info-compiled t)) 5846 5847 ;; Restore if necessary. Must use execute to hide lame routine_info 5848 ;; errors on undefinded routine 5849 (idlwave-shell-send-command 5850 (format "if execute(\"_v=routine_info('idlwave_routine_info',/SOURCE)\") eq 0 then restore,'%s' else if _v.path eq '' then restore,'%s'" 5851 idlwave-shell-temp-rinfo-save-file 5852 idlwave-shell-temp-rinfo-save-file) 5853 nil 'hide)) 5854 5855 5856(defun idlwave-shell-update-routine-info (&optional quiet run-hooks wait file) 5857 "Query the shell for routine_info of compiled modules and update the lists." 5858 ;; Save and compile the procedure. The compiled procedure is then 5859 ;; saved into an IDL SAVE file, to allow for fast RESTORE. We may 5860 ;; need to test for and possibly RESTORE the procedure each time we 5861 ;; use it, since the user may have killed or redefined it. In 5862 ;; particular, .RESET_SESSION will kill all user procedures. If 5863 ;; FILE is set, only update routine info for routines in that file. 5864 5865 (idlwave-shell-compile-helper-routines wait) 5866 ; execute the routine_info procedure, and analyze the output 5867 (idlwave-shell-send-command 5868 (format "idlwave_routine_info%s" (if file (concat ",'" file "'") "")) 5869 `(progn 5870 (idlwave-shell-routine-info-filter) 5871 (idlwave-concatenate-rinfo-lists ,quiet ,run-hooks)) 5872 'hide wait)) 5873 5874;; --------------------------------------------------------------------------- 5875;; 5876;; Completion and displaying routine calling sequences 5877 5878(defvar idlwave-completion-help-info nil) 5879(defvar idlwave-completion-help-links nil) 5880(defvar idlwave-current-obj_new-class nil) 5881(defvar idlwave-complete-special nil) 5882 5883(defun idlwave-complete (&optional arg module class) 5884 "Complete a function, procedure or keyword name at point. 5885This function is smart and figures out what can be completed 5886at this point. 5887- At the beginning of a statement it completes procedure names. 5888- In the middle of a statement it completes function names. 5889- after a `(' or `,' in the argument list of a function or procedure, 5890 it completes a keyword of the relevant function or procedure. 5891- In the first arg of `OBJ_NEW', it completes a class name. 5892 5893When several completions are possible, a list will be displayed in the 5894*Completions* buffer. If this list is too long to fit into the 5895window, scrolling can be achieved by repeatedly pressing 5896\\[idlwave-complete]. 5897 5898The function also knows about object methods. When it needs a class 5899name, the action depends upon `idlwave-query-class', which see. You 5900can force IDLWAVE to ask you for a class name with a 5901\\[universal-argument] prefix argument to this command. 5902 5903See also the variables `idlwave-keyword-completion-adds-equal' and 5904`idlwave-function-completion-adds-paren'. 5905 5906The optional ARG can be used to specify the completion type in order 5907to override IDLWAVE's idea of what should be completed at point. 5908Possible values are: 5909 59100 <=> query for the completion type 59111 <=> 'procedure 59122 <=> 'procedure-keyword 59133 <=> 'function 59144 <=> 'function-keyword 59155 <=> 'procedure-method 59166 <=> 'procedure-method-keyword 59177 <=> 'function-method 59188 <=> 'function-method-keyword 59199 <=> 'class 5920 5921As a special case, the universal argument C-u forces completion of 5922function names in places where the default would be a keyword. 5923 5924Two prefix argument, C-u C-u, prompts for a regexp by which to limit 5925completion. 5926 5927For Lisp programmers only: 5928When we force a keyword, optional argument MODULE can contain the module name. 5929When we force a method or a method keyword, CLASS can specify the class." 5930 (interactive "P") 5931 (idlwave-routines) 5932 (let* ((where-list 5933 (if (and arg 5934 (or (and (integerp arg) (not (equal arg '(16)))) 5935 (symbolp arg))) 5936 (idlwave-make-force-complete-where-list arg module class) 5937 (idlwave-where))) 5938 (what (nth 2 where-list)) 5939 (idlwave-force-class-query (equal arg '(4))) 5940 (completion-regexp-list 5941 (if (equal arg '(16)) 5942 (list (read-string (concat "Completion Regexp: ")))))) 5943 5944 (if (and module (string-match "::" module)) 5945 (setq class (substring module 0 (match-beginning 0)) 5946 module (substring module (match-end 0)))) 5947 5948 (cond 5949 5950 ((and (null arg) 5951 (eq (car-safe last-command) 'idlwave-display-completion-list) 5952 (get-buffer-window "*Completions*")) 5953 (setq this-command last-command) 5954 (idlwave-scroll-completions)) 5955 5956 ;; Complete a filename in quotes 5957 ((and (idlwave-in-quote) 5958 (not (eq what 'class))) 5959 (idlwave-complete-filename)) 5960 5961 ;; Check for any special completion functions 5962 ((and idlwave-complete-special 5963 (idlwave-call-special idlwave-complete-special))) 5964 5965 ((null what) 5966 (error "Nothing to complete here")) 5967 5968 ;; Complete a class 5969 ((eq what 'class) 5970 (setq idlwave-completion-help-info '(class)) 5971 (idlwave-complete-class)) 5972 5973 ((eq what 'procedure) 5974 ;; Complete a procedure name 5975 (let* ((cw-list (nth 3 where-list)) 5976 (class-selector (idlwave-determine-class cw-list 'pro)) 5977 (super-classes (unless (idlwave-explicit-class-listed cw-list) 5978 (idlwave-all-class-inherits class-selector))) 5979 (isa (concat "procedure" (if class-selector "-method" ""))) 5980 (type-selector 'pro)) 5981 (setq idlwave-completion-help-info 5982 (list 'routine nil type-selector class-selector nil super-classes)) 5983 (idlwave-complete-in-buffer 5984 'procedure (if class-selector 'method 'routine) 5985 (idlwave-routines) 'idlwave-selector 5986 (format "Select a %s name%s" 5987 isa 5988 (if class-selector 5989 (format " (class is %s)" 5990 (if (eq class-selector t) 5991 "unknown" class-selector)) 5992 "")) 5993 isa 5994 'idlwave-attach-method-classes 'idlwave-add-file-link-selector))) 5995 5996 ((eq what 'function) 5997 ;; Complete a function name 5998 (let* ((cw-list (nth 3 where-list)) 5999 (class-selector (idlwave-determine-class cw-list 'fun)) 6000 (super-classes (unless (idlwave-explicit-class-listed cw-list) 6001 (idlwave-all-class-inherits class-selector))) 6002 (isa (concat "function" (if class-selector "-method" ""))) 6003 (type-selector 'fun)) 6004 (setq idlwave-completion-help-info 6005 (list 'routine nil type-selector class-selector nil super-classes)) 6006 (idlwave-complete-in-buffer 6007 'function (if class-selector 'method 'routine) 6008 (idlwave-routines) 'idlwave-selector 6009 (format "Select a %s name%s" 6010 isa 6011 (if class-selector 6012 (format " (class is %s)" 6013 (if (eq class-selector t) 6014 "unknown" class-selector)) 6015 "")) 6016 isa 6017 'idlwave-attach-method-classes 'idlwave-add-file-link-selector))) 6018 6019 ((and (memq what '(procedure-keyword function-keyword)) ; Special Case 6020 (equal arg '(4))) 6021 (idlwave-complete 3)) 6022 6023 ((eq what 'procedure-keyword) 6024 ;; Complete a procedure keyword 6025 (let* ((where (nth 3 where-list)) 6026 (name (car where)) 6027 (method-selector name) 6028 (type-selector 'pro) 6029 (class (idlwave-determine-class where 'pro)) 6030 (class-selector class) 6031 (super-classes (idlwave-all-class-inherits class-selector)) 6032 (isa (format "procedure%s-keyword" (if class "-method" ""))) 6033 (entry (idlwave-best-rinfo-assq 6034 name 'pro class (idlwave-routines))) 6035 (system (if entry (eq (car (nth 3 entry)) 'system))) 6036 (list (idlwave-entry-keywords entry 'do-link))) 6037 (unless (or entry (eq class t)) 6038 (error "Nothing known about procedure %s" 6039 (idlwave-make-full-name class name))) 6040 (setq list (idlwave-fix-keywords name 'pro class list 6041 super-classes system)) 6042 (unless list (error "No keywords available for procedure %s" 6043 (idlwave-make-full-name class name))) 6044 (setq idlwave-completion-help-info 6045 (list 'keyword name type-selector class-selector entry super-classes)) 6046 (idlwave-complete-in-buffer 6047 'keyword 'keyword list nil 6048 (format "Select keyword for procedure %s%s" 6049 (idlwave-make-full-name class name) 6050 (if (or (member '("_EXTRA") list) 6051 (member '("_REF_EXTRA") list)) 6052 " (note _EXTRA)" "")) 6053 isa 6054 'idlwave-attach-keyword-classes))) 6055 6056 ((eq what 'function-keyword) 6057 ;; Complete a function keyword 6058 (let* ((where (nth 3 where-list)) 6059 (name (car where)) 6060 (method-selector name) 6061 (type-selector 'fun) 6062 (class (idlwave-determine-class where 'fun)) 6063 (class-selector class) 6064 (super-classes (idlwave-all-class-inherits class-selector)) 6065 (isa (format "function%s-keyword" (if class "-method" ""))) 6066 (entry (idlwave-best-rinfo-assq 6067 name 'fun class (idlwave-routines))) 6068 (system (if entry (eq (car (nth 3 entry)) 'system))) 6069 (list (idlwave-entry-keywords entry 'do-link)) 6070 msg-name) 6071 (unless (or entry (eq class t)) 6072 (error "Nothing known about function %s" 6073 (idlwave-make-full-name class name))) 6074 (setq list (idlwave-fix-keywords name 'fun class list 6075 super-classes system)) 6076 ;; OBJ_NEW: Messages mention the proper Init method 6077 (setq msg-name (if (and (null class) 6078 (string= (upcase name) "OBJ_NEW")) 6079 (concat idlwave-current-obj_new-class 6080 "::Init (via OBJ_NEW)") 6081 (idlwave-make-full-name class name))) 6082 (unless list (error "No keywords available for function %s" 6083 msg-name)) 6084 (setq idlwave-completion-help-info 6085 (list 'keyword name type-selector class-selector nil super-classes)) 6086 (idlwave-complete-in-buffer 6087 'keyword 'keyword list nil 6088 (format "Select keyword for function %s%s" msg-name 6089 (if (or (member '("_EXTRA") list) 6090 (member '("_REF_EXTRA") list)) 6091 " (note _EXTRA)" "")) 6092 isa 6093 'idlwave-attach-keyword-classes))) 6094 6095 (t (error "This should not happen (idlwave-complete)"))))) 6096 6097(defvar idlwave-complete-special nil 6098 "List of special completion functions. 6099These functions are called for each completion. Each function must 6100check if its own special completion context is present. If yes, it 6101should use `idlwave-complete-in-buffer' to do some completion and 6102return t. If such a function returns t, *no further* attempts to 6103complete other contexts will be done. If the function returns nil, 6104other completions will be tried.") 6105 6106(defun idlwave-call-special (functions &rest args) 6107 (let ((funcs functions) 6108 fun ret) 6109 (catch 'exit 6110 (while (setq fun (pop funcs)) 6111 (if (setq ret (apply fun args)) 6112 (throw 'exit ret))) 6113 nil))) 6114 6115(defun idlwave-make-force-complete-where-list (what &optional module class) 6116 ;; Return an artificial WHERE specification to force the completion 6117 ;; routine to complete a specific item independent of context. 6118 ;; WHAT is the prefix arg of `idlwave-complete', see there for details. 6119 ;; MODULE and CLASS can be used to specify the routine name and class. 6120 ;; The class name will also be found in MODULE if that is like "class::mod". 6121 (let* ((what-list '(("procedure") ("procedure-keyword") 6122 ("function") ("function-keyword") 6123 ("procedure-method") ("procedure-method-keyword") 6124 ("function-method") ("function-method-keyword") 6125 ("class"))) 6126 (module (idlwave-sintern-routine-or-method module class)) 6127 (class (idlwave-sintern-class class)) 6128 (what (cond 6129 ((equal what 0) 6130 (setq what 6131 (intern (completing-read 6132 "Complete what? " what-list nil t)))) 6133 ((integerp what) 6134 (setq what (intern (car (nth (1- what) what-list))))) 6135 ((and what 6136 (symbolp what) 6137 (assoc (symbol-name what) what-list)) 6138 what) 6139 (t (error "Invalid WHAT")))) 6140 (nil-list '(nil nil nil nil)) 6141 (class-list (list nil nil (or class t) nil))) 6142 6143 (cond 6144 6145 ((eq what 'procedure) 6146 (list nil-list nil-list 'procedure nil-list nil)) 6147 6148 ((eq what 'procedure-keyword) 6149 (let* ((class-selector nil) 6150 (super-classes nil) 6151 (type-selector 'pro) 6152 (pro (or module 6153 (idlwave-completing-read 6154 "Procedure: " (idlwave-routines) 'idlwave-selector)))) 6155 (setq pro (idlwave-sintern-routine pro)) 6156 (list nil-list nil-list 'procedure-keyword 6157 (list pro nil nil nil) nil))) 6158 6159 ((eq what 'function) 6160 (list nil-list nil-list 'function nil-list nil)) 6161 6162 ((eq what 'function-keyword) 6163 (let* ((class-selector nil) 6164 (super-classes nil) 6165 (type-selector 'fun) 6166 (func (or module 6167 (idlwave-completing-read 6168 "Function: " (idlwave-routines) 'idlwave-selector)))) 6169 (setq func (idlwave-sintern-routine func)) 6170 (list nil-list nil-list 'function-keyword 6171 (list func nil nil nil) nil))) 6172 6173 ((eq what 'procedure-method) 6174 (list nil-list nil-list 'procedure class-list nil)) 6175 6176 ((eq what 'procedure-method-keyword) 6177 (let* ((class (idlwave-determine-class class-list 'pro)) 6178 (class-selector class) 6179 (super-classes (idlwave-all-class-inherits class-selector)) 6180 (type-selector 'pro) 6181 (pro (or module 6182 (idlwave-completing-read 6183 (format "Procedure in %s class: " class-selector) 6184 (idlwave-routines) 'idlwave-selector)))) 6185 (setq pro (idlwave-sintern-method pro)) 6186 (list nil-list nil-list 'procedure-keyword 6187 (list pro nil class nil) nil))) 6188 6189 ((eq what 'function-method) 6190 (list nil-list nil-list 'function class-list nil)) 6191 6192 ((eq what 'function-method-keyword) 6193 (let* ((class (idlwave-determine-class class-list 'fun)) 6194 (class-selector class) 6195 (super-classes (idlwave-all-class-inherits class-selector)) 6196 (type-selector 'fun) 6197 (func (or module 6198 (idlwave-completing-read 6199 (format "Function in %s class: " class-selector) 6200 (idlwave-routines) 'idlwave-selector)))) 6201 (setq func (idlwave-sintern-method func)) 6202 (list nil-list nil-list 'function-keyword 6203 (list func nil class nil) nil))) 6204 6205 ((eq what 'class) 6206 (list nil-list nil-list 'class nil-list nil)) 6207 6208 (t (error "Invalid value for WHAT"))))) 6209 6210(defun idlwave-completing-read (&rest args) 6211 ;; Completing read, case insensitive 6212 (let ((old-value (default-value 'completion-ignore-case))) 6213 (unwind-protect 6214 (progn 6215 (setq-default completion-ignore-case t) 6216 (apply 'completing-read args)) 6217 (setq-default completion-ignore-case old-value)))) 6218 6219(defvar idlwave-shell-default-directory) 6220(defun idlwave-complete-filename () 6221 "Use the comint stuff to complete a file name." 6222 (require 'comint) 6223 (let* ((comint-file-name-chars "~/A-Za-z0-9+@:_.$#%={}\\-") 6224 (comint-completion-addsuffix nil) 6225 (default-directory 6226 (if (and (boundp 'idlwave-shell-default-directory) 6227 (stringp idlwave-shell-default-directory) 6228 (file-directory-p idlwave-shell-default-directory)) 6229 idlwave-shell-default-directory 6230 default-directory))) 6231 (comint-dynamic-complete-filename))) 6232 6233(defun idlwave-make-full-name (class name) 6234 ;; Make a fully qualified module name including the class name 6235 (concat (if class (format "%s::" class) "") name)) 6236 6237(defun idlwave-rinfo-assoc (name type class list) 6238 "Like `idlwave-rinfo-assq', but sintern strings first." 6239 (idlwave-rinfo-assq 6240 (idlwave-sintern-routine-or-method name class) 6241 type (idlwave-sintern-class class) list)) 6242 6243(defun idlwave-rinfo-assq (name type class list) 6244 ;; Works like assq, but also checks type and class 6245 (catch 'exit 6246 (let (match) 6247 (while (setq match (assq name list)) 6248 (and (or (eq type t) 6249 (eq (nth 1 match) type)) 6250 (eq (nth 2 match) class) 6251 (throw 'exit match)) 6252 (setq list (cdr (memq match list))))))) 6253 6254(defun idlwave-rinfo-assq-any-class (name type class list) 6255 ;; Return the first matching method on the inheritance list 6256 (let* ((classes (cons class (idlwave-all-class-inherits class))) 6257 class rtn) 6258 (while classes 6259 (if (setq rtn (idlwave-rinfo-assq name type (pop classes) list)) 6260 (setq classes nil))) 6261 rtn)) 6262 6263(defun idlwave-best-rinfo-assq (name type class list &optional with-file 6264 keep-system) 6265 "Like `idlwave-rinfo-assq', but get all twins and sort, then return first. 6266If WITH-FILE is passed, find the best rinfo entry with a file 6267included. If KEEP-SYSTEM is set, don't prune system for compiled 6268syslib files." 6269 (let ((twins (idlwave-routine-twins 6270 (idlwave-rinfo-assq-any-class name type class list) 6271 list)) 6272 syslibp) 6273 (when (> (length twins) 1) 6274 (setq twins (sort twins 'idlwave-routine-entry-compare-twins)) 6275 (if (and (null keep-system) 6276 (eq 'system (car (nth 3 (car twins)))) 6277 (setq syslibp (idlwave-any-syslib (cdr twins))) 6278 (not (equal 1 syslibp))) 6279 ;; Its a compiled syslib, so we need to remove the system entry 6280 (setq twins (cdr twins))) 6281 (if with-file 6282 (setq twins (delq nil 6283 (mapcar (lambda (x) 6284 (if (nth 1 (nth 3 x)) x)) 6285 twins))))) 6286 (car twins))) 6287 6288(defun idlwave-best-rinfo-assoc (name type class list &optional with-file 6289 keep-system) 6290 "Like `idlwave-best-rinfo-assq', but sintern strings first." 6291 (idlwave-best-rinfo-assq 6292 (idlwave-sintern-routine-or-method name class) 6293 type (idlwave-sintern-class class) list with-file keep-system)) 6294 6295(defun idlwave-any-syslib (entries) 6296 "Does the entry list ENTRIES contain a syslib entry? 6297If yes, return the index (>=1)." 6298 (let (file (cnt 0)) 6299 (catch 'exit 6300 (while entries 6301 (incf cnt) 6302 (setq file (idlwave-routine-source-file (nth 3 (car entries)))) 6303 (if (and file (idlwave-syslib-p file)) 6304 (throw 'exit cnt) 6305 (setq entries (cdr entries)))) 6306 nil))) 6307 6308(defun idlwave-all-assq (key list) 6309 "Return a list of all associations of Key in LIST." 6310 (let (rtn elt) 6311 (while (setq elt (assq key list)) 6312 (push elt rtn) 6313 (setq list (cdr (memq elt list)))) 6314 (nreverse rtn))) 6315 6316(defun idlwave-all-method-classes (method &optional type) 6317 "Return all classes which have a method METHOD. TYPE is 'fun or 'pro. 6318When TYPE is not specified, both procedures and functions will be considered." 6319 (if (null method) 6320 (mapcar 'car (idlwave-class-alist)) 6321 (let (rtn) 6322 (mapcar (lambda (x) 6323 (and (nth 2 x) 6324 (or (not type) 6325 (eq type (nth 1 x))) 6326 (push (nth 2 x) rtn))) 6327 (idlwave-all-assq method (idlwave-routines))) 6328 (idlwave-uniquify rtn)))) 6329 6330(defun idlwave-all-method-keyword-classes (method keyword &optional type) 6331 "Return all classes which have a method METHOD with keyword KEYWORD. 6332TYPE is 'fun or 'pro. 6333When TYPE is not specified, both procedures and functions will be considered." 6334 (if (or (null method) 6335 (null keyword)) 6336 nil 6337 (let (rtn) 6338 (mapcar (lambda (x) 6339 (and (nth 2 x) ; non-nil class 6340 (or (not type) ; correct or unspecified type 6341 (eq type (nth 1 x))) 6342 (assoc keyword (idlwave-entry-keywords x)) 6343 (push (nth 2 x) rtn))) 6344 (idlwave-all-assq method (idlwave-routines))) 6345 (idlwave-uniquify rtn)))) 6346 6347(defun idlwave-members-only (list club) 6348 "Return list of all elements in LIST which are also in CLUB." 6349 (let (rtn) 6350 (while list 6351 (if (member (car list) club) 6352 (setq rtn (cons (car list) rtn))) 6353 (setq list (cdr list))) 6354 (nreverse rtn))) 6355 6356(defun idlwave-nonmembers-only (list club) 6357 "Return list of all elements in LIST which are not in CLUB." 6358 (let (rtn) 6359 (while list 6360 (if (member (car list) club) 6361 nil 6362 (setq rtn (cons (car list) rtn))) 6363 (setq list (cdr list))) 6364 (nreverse rtn))) 6365 6366(defun idlwave-explicit-class-listed (info) 6367 "Return whether or not the class is listed explicitly, ala a->b::c. 6368INFO is as returned by idlwave-what-function or -procedure." 6369 (let ((apos (nth 3 info))) 6370 (if apos 6371 (save-excursion (goto-char apos) 6372 (looking-at "->[a-zA-Z][a-zA-Z0-9$_]*::"))))) 6373 6374(defvar idlwave-determine-class-special nil 6375 "List of special functions for determining class. 6376Must accept two arguments: `apos' and `info'") 6377 6378(defun idlwave-determine-class (info type) 6379 ;; Determine the class of a routine call. 6380 ;; INFO is the `cw-list' structure as returned by idlwave-where. 6381 ;; The second element in this structure is the class. When nil, we 6382 ;; return nil. When t, try to get the class from text properties at 6383 ;; the arrow. When the object is "self", we use the class of the 6384 ;; current routine. otherwise prompt the user for a class name. 6385 ;; Also stores the selected class as a text property at the arrow. 6386 ;; TYPE is 'fun or 'pro. 6387 (let* ((class (nth 2 info)) 6388 (apos (nth 3 info)) 6389 (nassoc (assoc (if (stringp (car info)) 6390 (upcase (car info)) 6391 (car info)) 6392 idlwave-query-class)) 6393 (dassoc (assq (if (car info) 'keyword-default 'method-default) 6394 idlwave-query-class)) 6395 (query (cond (nassoc (cdr nassoc)) 6396 (dassoc (cdr dassoc)) 6397 (t t))) 6398 (arrow (and apos (string= (buffer-substring apos (+ 2 apos)) "->"))) 6399 (is-self 6400 (and arrow 6401 (save-excursion (goto-char apos) 6402 (forward-word -1) 6403 (let ((case-fold-search t)) 6404 (looking-at "self\\>"))))) 6405 (force-query idlwave-force-class-query) 6406 store special-class class-alist) 6407 (cond 6408 ((null class) nil) 6409 ((eq t class) 6410 ;; There is an object which would like to know its class 6411 (if (and arrow (get-text-property apos 'idlwave-class) 6412 idlwave-store-inquired-class 6413 (not force-query)) 6414 (setq class (get-text-property apos 'idlwave-class) 6415 class (idlwave-sintern-class class))) 6416 (if (and (eq t class) is-self) 6417 (setq class (or (nth 2 (idlwave-current-routine)) class))) 6418 6419 ;; Before prompting, try any special class determination routines 6420 (when (and (eq t class) 6421 idlwave-determine-class-special 6422 (not force-query)) 6423 (setq special-class 6424 (idlwave-call-special idlwave-determine-class-special apos)) 6425 (if special-class 6426 (setq class (idlwave-sintern-class special-class) 6427 store idlwave-store-inquired-class))) 6428 6429 ;; Prompt for a class, if we need to 6430 (when (and (eq class t) 6431 (or force-query query)) 6432 (setq class-alist 6433 (mapcar 'list (idlwave-all-method-classes (car info) type))) 6434 (setq class 6435 (idlwave-sintern-class 6436 (cond 6437 ((and (= (length class-alist) 0) (not force-query)) 6438 (error "No classes available with method %s" (car info))) 6439 ((and (= (length class-alist) 1) (not force-query)) 6440 (car (car class-alist))) 6441 (t 6442 (setq store idlwave-store-inquired-class) 6443 (idlwave-completing-read 6444 (format "Class%s: " (if (stringp (car info)) 6445 (format " for %s method %s" 6446 type (car info)) 6447 "")) 6448 class-alist nil nil nil 'idlwave-class-history)))))) 6449 6450 ;; Store it, if requested 6451 (when (and class (not (eq t class))) 6452 ;; We have a real class here 6453 (when (and store arrow) 6454 (condition-case () 6455 (add-text-properties 6456 apos (+ apos 2) 6457 `(idlwave-class ,class face ,idlwave-class-arrow-face 6458 rear-nonsticky t)) 6459 (error nil))) 6460 (setf (nth 2 info) class)) 6461 ;; Return the class 6462 class) 6463 ;; Default as fallback 6464 (t class)))) 6465 6466(defvar type-selector) 6467(defvar class-selector) 6468(defvar method-selector) 6469(defvar super-classes) 6470(defun idlwave-selector (a) 6471 (and (eq (nth 1 a) type-selector) 6472 (or (and (nth 2 a) (eq class-selector t)) 6473 (eq (nth 2 a) class-selector) 6474 (memq (nth 2 a) super-classes)))) 6475 6476(defun idlwave-add-file-link-selector (a) 6477 ;; Record a file link, if any, for the tested names during selection. 6478 (let ((sel (idlwave-selector a)) file) 6479 (if (and sel (setq file (idlwave-entry-has-help a))) 6480 (push (cons (car a) file) idlwave-completion-help-links)) 6481 sel)) 6482 6483 6484(defun idlwave-where () 6485 "Find out where we are. 6486The return value is a list with the following stuff: 6487\(PRO-LIST FUNC-LIST COMPLETE-WHAT CW-LIST LAST-CHAR) 6488 6489PRO-LIST (PRO POINT CLASS ARROW) 6490FUNC-LIST (FUNC POINT CLASS ARROW) 6491COMPLETE-WHAT a symbol indicating what kind of completion makes sense here 6492CW-LIST (PRO-OR-FUNC POINT CLASS ARROW) Like PRO-LIST, for what can 6493 be completed here. 6494LAST-CHAR last relevant character before point (non-white non-comment, 6495 not part of current identifier or leading slash). 6496 6497In the lists, we have these meanings: 6498PRO: Procedure name 6499FUNC: Function name 6500POINT: Where is this 6501CLASS: What class has the routine (nil=no, t=is method, but class unknown) 6502ARROW: Location of the arrow" 6503 (idlwave-routines) 6504 (let* (;(bos (save-excursion (idlwave-beginning-of-statement) (point))) 6505 (bos (save-excursion (idlwave-start-of-substatement 'pre) (point))) 6506 (func-entry (idlwave-what-function bos)) 6507 (func (car func-entry)) 6508 (func-class (nth 1 func-entry)) 6509 (func-arrow (nth 2 func-entry)) 6510 (func-point (or (nth 3 func-entry) 0)) 6511 (func-level (or (nth 4 func-entry) 0)) 6512 (pro-entry (idlwave-what-procedure bos)) 6513 (pro (car pro-entry)) 6514 (pro-class (nth 1 pro-entry)) 6515 (pro-arrow (nth 2 pro-entry)) 6516 (pro-point (or (nth 3 pro-entry) 0)) 6517 (last-char (idlwave-last-valid-char)) 6518 (case-fold-search t) 6519 (match-string (buffer-substring bos (point))) 6520 cw cw-mod cw-arrow cw-class cw-point) 6521 (if (< func-point pro-point) (setq func nil)) 6522 (cond 6523 ((string-match "\\`[ \t]*\\(pro\\|function\\)[ \t]+[a-zA-Z0-9_]*\\'" 6524 match-string) 6525 (setq cw 'class)) 6526 ((string-match 6527 "\\`[ \t]*\\([a-zA-Z][a-zA-Z0-9$_]*\\)?\\'" 6528 (if (> pro-point 0) 6529 (buffer-substring pro-point (point)) 6530 match-string)) 6531 (setq cw 'procedure cw-class pro-class cw-point pro-point 6532 cw-arrow pro-arrow)) 6533 ((string-match "\\`[ \t]*\\(pro\\|function\\)\\>" 6534 match-string) 6535 nil) 6536 ((string-match "OBJ_NEW([ \t]*['\"]\\([a-zA-Z0-9$_]*\\)?\\'" 6537 match-string) 6538 (setq cw 'class)) 6539 ((string-match "\\<inherits\\s-+\\([a-zA-Z0-9$_]*\\)?\\'" 6540 match-string) 6541 (setq cw 'class)) 6542 ((and func 6543 (> func-point pro-point) 6544 (= func-level 1) 6545 (memq last-char '(?\( ?,))) 6546 (setq cw 'function-keyword cw-mod func cw-point func-point 6547 cw-class func-class cw-arrow func-arrow)) 6548 ((and pro (eq last-char ?,)) 6549 (setq cw 'procedure-keyword cw-mod pro cw-point pro-point 6550 cw-class pro-class cw-arrow pro-arrow)) 6551; ((member last-char '(?\' ?\) ?\] ?!)) 6552; ;; after these chars, a function makes no sense 6553; ;; FIXME: I am sure there can be more in this list 6554; ;; FIXME: Do we want to do this at all? 6555; nil) 6556 ;; Everywhere else we try a function. 6557 (t 6558 (setq cw 'function) 6559 (save-excursion 6560 (if (re-search-backward "->[ \t]*\\(\\$[ \t]*\\(;.*\\)?\n\\s-*\\)?\\(\\([$a-zA-Z0-9_]+\\)::\\)?[$a-zA-Z0-9_]*\\=" bos t) 6561 (setq cw-arrow (copy-marker (match-beginning 0)) 6562 cw-class (if (match-end 4) 6563 (idlwave-sintern-class (match-string 4)) 6564 t)))))) 6565 (list (list pro pro-point pro-class pro-arrow) 6566 (list func func-point func-class func-arrow) 6567 cw 6568 (list cw-mod cw-point cw-class cw-arrow) 6569 last-char))) 6570 6571(defun idlwave-this-word (&optional class) 6572 ;; Grab the word around point. CLASS is for the `skip-chars=...' functions 6573 (setq class (or class "a-zA-Z0-9$_.")) 6574 (save-excursion 6575 (buffer-substring 6576 (progn (skip-chars-backward class) (point)) 6577 (progn (skip-chars-forward class) (point))))) 6578 6579(defun idlwave-what-function (&optional bound) 6580 ;; Find out if point is within the argument list of a function. 6581 ;; The return value is ("function-name" class arrow-start (point) level). 6582 ;; Level is 1 on the top level parentheses, higher further down. 6583 6584 ;; If the optional BOUND is an integer, bound backwards directed 6585 ;; searches to this point. 6586 6587 (catch 'exit 6588 (let (pos 6589 func-point 6590 (cnt 0) 6591 func arrow-start class) 6592 (idlwave-with-special-syntax 6593 (save-restriction 6594 (save-excursion 6595 (narrow-to-region (max 1 (or bound 0)) (point-max)) 6596 ;; move back out of the current parenthesis 6597 (while (condition-case nil 6598 (progn (up-list -1) t) 6599 (error nil)) 6600 (setq pos (point)) 6601 (incf cnt) 6602 (when (and (= (following-char) ?\() 6603 (re-search-backward 6604 "\\(::\\|\\<\\)\\([a-zA-Z][a-zA-Z0-9$_]*\\)[ \t]*\\=" 6605 bound t)) 6606 (setq func (match-string 2) 6607 func-point (goto-char (match-beginning 2)) 6608 pos func-point) 6609 (if (re-search-backward 6610 "->[ \t]*\\(\\([a-zA-Z][a-zA-Z0-9$_]*\\)::\\)?\\=" bound t) 6611 (setq arrow-start (copy-marker (match-beginning 0)) 6612 class (or (match-string 2) t))) 6613 (throw 6614 'exit 6615 (list 6616 (idlwave-sintern-routine-or-method func class) 6617 (idlwave-sintern-class class) 6618 arrow-start func-point cnt))) 6619 (goto-char pos)) 6620 (throw 'exit nil))))))) 6621 6622(defun idlwave-what-procedure (&optional bound) 6623 ;; Find out if point is within the argument list of a procedure. 6624 ;; The return value is ("procedure-name" class arrow-pos (point)). 6625 6626 ;; If the optional BOUND is an integer, bound backwards directed 6627 ;; searches to this point. 6628 (let ((pos (point)) pro-point 6629 pro class arrow-start string) 6630 (save-excursion 6631 ;;(idlwave-beginning-of-statement) 6632 (idlwave-start-of-substatement 'pre) 6633 (setq string (buffer-substring (point) pos)) 6634 (if (string-match 6635 "\\`[ \t]*\\([a-zA-Z][a-zA-Z0-9$_]*\\)[ \t]*\\(,\\|\\'\\)" string) 6636 (setq pro (match-string 1 string) 6637 pro-point (+ (point) (match-beginning 1))) 6638 (if (and (idlwave-skip-object) 6639 (setq string (buffer-substring (point) pos)) 6640 (string-match 6641 "\\`[ \t]*\\(->\\)[ \t]*\\(\\([a-zA-Z][a-zA-Z0-9$_]*\\)::\\)?\\([a-zA-Z][a-zA-Z0-9$_]*\\)?[ \t]*\\(,\\|\\(\\$\\s *\\(;.*\\)?\\)?$\\)" 6642 string)) 6643 (setq pro (if (match-beginning 4) 6644 (match-string 4 string)) 6645 pro-point (if (match-beginning 4) 6646 (+ (point) (match-beginning 4)) 6647 pos) 6648 arrow-start (copy-marker (+ (point) (match-beginning 1))) 6649 class (or (match-string 3 string) t))))) 6650 (list (idlwave-sintern-routine-or-method pro class) 6651 (idlwave-sintern-class class) 6652 arrow-start 6653 pro-point))) 6654 6655(defun idlwave-skip-object () 6656 ;; If there is an object at point, move over it and return t. 6657 (let ((pos (point))) 6658 (if (catch 'exit 6659 (save-excursion 6660 (skip-chars-forward " ") ; white space 6661 (skip-chars-forward "*") ; de-reference 6662 (cond 6663 ((looking-at idlwave-identifier) 6664 (goto-char (match-end 0))) 6665 ((eq (following-char) ?\() 6666 nil) 6667 (t (throw 'exit nil))) 6668 (catch 'endwhile 6669 (while t 6670 (cond ((eq (following-char) ?.) 6671 (forward-char 1) 6672 (if (not (looking-at idlwave-identifier)) 6673 (throw 'exit nil)) 6674 (goto-char (match-end 0))) 6675 ((memq (following-char) '(?\( ?\[)) 6676 (condition-case nil 6677 (forward-list 1) 6678 (error (throw 'exit nil)))) 6679 (t (throw 'endwhile t))))) 6680 (if (looking-at "[ \t]*->") 6681 (throw 'exit (setq pos (match-beginning 0))) 6682 (throw 'exit nil)))) 6683 (goto-char pos) 6684 nil))) 6685 6686(defun idlwave-last-valid-char () 6687 "Return the last character before point which is not white or a comment 6688and also not part of the current identifier. Since we do this in 6689order to identify places where keywords are, we consider the initial 6690`/' of a keyword as part of the identifier. 6691This function is not general, can only be used for completion stuff." 6692 (catch 'exit 6693 (save-excursion 6694 ;; skip the current identifier 6695 (skip-chars-backward "a-zA-Z0-9_$") 6696 ;; also skip a leading slash which might be belong to the keyword 6697 (if (eq (preceding-char) ?/) 6698 (backward-char 1)) 6699 ;; FIXME: does not check if this is a valid identifier 6700 (while t 6701 (skip-chars-backward " \t") 6702 (cond 6703 ((memq (preceding-char) '(?\; ?\$)) (throw 'exit nil)) 6704 ((eq (preceding-char) ?\n) 6705 (beginning-of-line 0) 6706 (if (looking-at "\\([^\n]*\\)\\$[ \t]*\\(;[^\n]*\\)?\n") 6707 ;; continuation line 6708 (goto-char (match-end 1)) 6709 (throw 'exit nil))) 6710 (t (throw 'exit (preceding-char)))))))) 6711 6712(defvar idlwave-complete-after-success-form nil 6713 "A form to evaluate after successful completion.") 6714(defvar idlwave-complete-after-success-form-force nil 6715 "A form to evaluate after completion selection in *Completions* buffer.") 6716(defconst idlwave-completion-mark (make-marker) 6717 "A mark pointing to the beginning of the completion string.") 6718 6719(defun idlwave-complete-in-buffer (type stype list selector prompt isa 6720 &optional prepare-display-function 6721 special-selector) 6722 "Perform TYPE completion of word before point against LIST. 6723SELECTOR is the PREDICATE argument for the completion function. Show 6724PROMPT in echo area. TYPE is one of the intern types, e.g. 'function, 6725'procedure, 'class-tag, 'keyword, 'sysvar, etc.. SPECIAL-SELECTOR is 6726used only once, for `all-completions', and can be used to, e.g., 6727accumulate information on matching completions." 6728 (let* ((completion-ignore-case t) 6729 beg (end (point)) slash part spart completion all-completions 6730 dpart dcompletion) 6731 6732 (unless list 6733 (error (concat prompt ": No completions available"))) 6734 6735 ;; What is already in the buffer? 6736 (save-excursion 6737 (skip-chars-backward "a-zA-Z0-9_$") 6738 (setq slash (eq (preceding-char) ?/) 6739 beg (point) 6740 idlwave-complete-after-success-form 6741 (list 'idlwave-after-successful-completion 6742 (list 'quote type) slash beg) 6743 idlwave-complete-after-success-form-force 6744 (list 'idlwave-after-successful-completion 6745 (list 'quote type) slash (list 'quote 'force)))) 6746 6747 ;; Try a completion 6748 (setq part (buffer-substring beg end) 6749 dpart (downcase part) 6750 spart (idlwave-sintern stype part) 6751 completion (try-completion part list selector) 6752 dcompletion (if (stringp completion) (downcase completion)) 6753 idlwave-completion-help-links nil) 6754 (cond 6755 ((null completion) 6756 ;; nothing available. 6757 (error (concat prompt ": no completion for \"%s\"") part)) 6758 ((and (not (equal dpart dcompletion)) 6759 (not (eq t completion))) 6760 ;; We can add something 6761 (delete-region beg end) 6762 (if (and (string= part dpart) 6763 (or (not (string= part "")) 6764 idlwave-complete-empty-string-as-lower-case) 6765 (not idlwave-completion-force-default-case)) 6766 (insert dcompletion) 6767 (insert completion)) 6768 (if (eq t (try-completion completion list selector)) 6769 ;; Now this is a unique match 6770 (idlwave-after-successful-completion type slash beg)) 6771 t) 6772 ((or (eq completion t) 6773 (and (= 1 (length (setq all-completions 6774 (idlwave-uniquify 6775 (all-completions part list 6776 (or special-selector 6777 selector)))))) 6778 (equal dpart dcompletion))) 6779 ;; This is already complete 6780 (idlwave-after-successful-completion type slash beg) 6781 (message "%s is already the complete %s" part isa) 6782 nil) 6783 (t 6784 ;; We cannot add something - offer a list. 6785 (message "Making completion list...") 6786 6787 (unless idlwave-completion-help-links ; already set somewhere? 6788 (mapcar (lambda (x) ; Pass link prop through to highlight-linked 6789 (let ((link (get-text-property 0 'link (car x)))) 6790 (if link 6791 (push (cons (car x) link) 6792 idlwave-completion-help-links)))) 6793 list)) 6794 (let* ((list all-completions) 6795 ;; "complete" means, this is already a valid completion 6796 (complete (memq spart all-completions)) 6797 (completion-highlight-first-word-only t)) ; XEmacs 6798; (completion-fixup-function ; Emacs 6799; (lambda () (and (eq (preceding-char) ?>) 6800; (re-search-backward " <" beg t))))) 6801 6802 (setq list (sort list (lambda (a b) 6803 (string< (downcase a) (downcase b))))) 6804 (if prepare-display-function 6805 (setq list (funcall prepare-display-function list))) 6806 (if (and (string= part dpart) 6807 (or (not (string= part "")) 6808 idlwave-complete-empty-string-as-lower-case) 6809 (not idlwave-completion-force-default-case)) 6810 (setq list (mapcar (lambda (x) 6811 (if (listp x) 6812 (setcar x (downcase (car x))) 6813 (setq x (downcase x))) 6814 x) 6815 list))) 6816 (idlwave-display-completion-list list prompt beg complete)) 6817 t)))) 6818 6819(defun idlwave-complete-class () 6820 "Complete a class at point." 6821 (interactive) 6822 ;; Call `idlwave-routines' to make sure the class list will be available 6823 (idlwave-routines) 6824 ;; Check for the special case of completing empty string after pro/function 6825 (if (let ((case-fold-search t)) 6826 (save-excursion 6827 (and 6828 (re-search-backward "\\<\\(pro\\|function\\)[ \t]+\\=" 6829 (- (point) 15) t) 6830 (goto-char (point-min)) 6831 (re-search-forward 6832 "^[ \t]*\\(pro\\|function\\)[ \t]+\\([a-zA-Z0-9_]+::\\)" nil t)))) 6833 ;; Yank the full class specification 6834 (insert (match-string 2)) 6835 ;; Do the completion, using list gathered from `idlwave-routines' 6836 (idlwave-complete-in-buffer 6837 'class 'class (idlwave-class-alist) nil 6838 "Select a class" "class" 6839 '(lambda (list) ;; Push it to help-links if system help available 6840 (mapcar (lambda (x) 6841 (let* ((entry (idlwave-class-info x)) 6842 (link (nth 1 (assq 'link entry)))) 6843 (if link (push (cons x link) 6844 idlwave-completion-help-links)) 6845 x)) 6846 list))))) 6847 6848(defun idlwave-attach-classes (list type show-classes) 6849 ;; Attach the proper class list to a LIST of completion items. 6850 ;; TYPE, when 'kwd, shows classes for method keywords, when 6851 ;; 'class-tag, for class tags, and otherwise for methods. 6852 ;; SHOW-CLASSES is the value of `idlwave-completion-show-classes'. 6853 (if (or (null show-classes) ; don't want to see classes 6854 (null class-selector) ; not a method call 6855 (and 6856 (stringp class-selector) ; the class is already known 6857 (not super-classes))) ; no possibilities for inheritance 6858 ;; In these cases, we do not have to do anything 6859 list 6860 (let* ((do-prop (and (>= show-classes 0) 6861 (>= emacs-major-version 21))) 6862 (do-buf (not (= show-classes 0))) 6863 ;; (do-dots (featurep 'xemacs)) 6864 (do-dots t) 6865 (inherit (if (and (not (eq type 'class-tag)) super-classes) 6866 (cons class-selector super-classes))) 6867 (max (abs show-classes)) 6868 (lmax (if do-dots (apply 'max (mapcar 'length list)))) 6869 classes nclasses class-info space) 6870 (mapcar 6871 (lambda (x) 6872 ;; get the classes 6873 (if (eq type 'class-tag) 6874 ;; Just one class for tags 6875 (setq classes 6876 (list 6877 (idlwave-class-or-superclass-with-tag class-selector x))) 6878 ;; Multiple classes for method or method-keyword 6879 (setq classes 6880 (if (eq type 'kwd) 6881 (idlwave-all-method-keyword-classes 6882 method-selector x type-selector) 6883 (idlwave-all-method-classes x type-selector))) 6884 (if inherit 6885 (setq classes 6886 (delq nil 6887 (mapcar (lambda (x) (if (memq x inherit) x nil)) 6888 classes))))) 6889 (setq nclasses (length classes)) 6890 ;; Make the separator between item and class-info 6891 (if do-dots 6892 (setq space (concat " " (make-string (- lmax (length x)) ?.))) 6893 (setq space " ")) 6894 (if do-buf 6895 ;; We do want info in the buffer 6896 (if (<= nclasses max) 6897 (setq class-info (concat 6898 space 6899 "<" (mapconcat 'identity classes ",") ">")) 6900 (setq class-info (format "%s<%d classes>" space nclasses))) 6901 (setq class-info nil)) 6902 (when do-prop 6903 ;; We do want properties 6904 (setq x (copy-sequence x)) 6905 (put-text-property 0 (length x) 6906 'help-echo (mapconcat 'identity classes " ") 6907 x)) 6908 (if class-info 6909 (list x class-info) 6910 x)) 6911 list)))) 6912 6913(defun idlwave-attach-method-classes (list) 6914 ;; Call idlwave-attach-classes with method parameters 6915 (idlwave-attach-classes list 'method idlwave-completion-show-classes)) 6916(defun idlwave-attach-keyword-classes (list) 6917 ;; Call idlwave-attach-classes with keyword parameters 6918 (idlwave-attach-classes list 'kwd idlwave-completion-show-classes)) 6919(defun idlwave-attach-class-tag-classes (list) 6920 ;; Call idlwave-attach-classes with class structure tags 6921 (idlwave-attach-classes list 'class-tag idlwave-completion-show-classes)) 6922 6923 6924;;---------------------------------------------------------------------- 6925;;---------------------------------------------------------------------- 6926;;---------------------------------------------------------------------- 6927;;---------------------------------------------------------------------- 6928;;---------------------------------------------------------------------- 6929(defvar rtn) 6930(defun idlwave-pset (item) 6931 (set 'rtn item)) 6932 6933(defun idlwave-popup-select (ev list title &optional sort) 6934 "Select an item in LIST with a popup menu. 6935TITLE is the title to put atop the popup. If SORT is non-nil, 6936sort the list before displaying" 6937 (let ((maxpopup idlwave-max-popup-menu-items) 6938 rtn menu resp) 6939 (cond ((null list)) 6940 ((= 1 (length list)) 6941 (setq rtn (car list))) 6942 ((featurep 'xemacs) 6943 (if sort (setq list (sort list (lambda (a b) 6944 (string< (upcase a) (upcase b)))))) 6945 (setq menu 6946 (append (list title) 6947 (mapcar (lambda (x) (vector x (list 'idlwave-pset 6948 x))) 6949 list))) 6950 (setq menu (idlwave-split-menu-xemacs menu maxpopup)) 6951 (setq resp (get-popup-menu-response menu)) 6952 (funcall (event-function resp) (event-object resp))) 6953 (t 6954 (if sort (setq list (sort list (lambda (a b) 6955 (string< (upcase a) (upcase b)))))) 6956 (setq menu (cons title 6957 (list 6958 (append (list "") 6959 (mapcar (lambda(x) (cons x x)) list))))) 6960 (setq menu (idlwave-split-menu-emacs menu maxpopup)) 6961 (setq rtn (x-popup-menu ev menu)))) 6962 rtn)) 6963 6964(defun idlwave-split-menu-xemacs (menu N) 6965 "Split the MENU into submenus of maximum length N." 6966 (if (<= (length menu) (1+ N)) 6967 ;; No splitting needed 6968 menu 6969 (let* ((title (car menu)) 6970 (entries (cdr menu)) 6971 (menu (list title)) 6972 (cnt 0) 6973 (nextmenu nil)) 6974 (while entries 6975 (while (and entries (< cnt N)) 6976 (setq cnt (1+ cnt) 6977 nextmenu (cons (car entries) nextmenu) 6978 entries (cdr entries))) 6979 (setq nextmenu (nreverse nextmenu)) 6980 (setq nextmenu (cons (format "%s...%s" 6981 (aref (car nextmenu) 0) 6982 (aref (nth (1- cnt) nextmenu) 0)) 6983 nextmenu)) 6984 (setq menu (cons nextmenu menu) 6985 nextmenu nil 6986 cnt 0)) 6987 (nreverse menu)))) 6988 6989(defun idlwave-split-menu-emacs (menu N) 6990 "Split the MENU into submenus of maximum length N." 6991 (if (<= (length (nth 1 menu)) (1+ N)) 6992 ;; No splitting needed 6993 menu 6994 (let* ((title (car menu)) 6995 (entries (cdr (nth 1 menu))) 6996 (menu nil) 6997 (cnt 0) 6998 (nextmenu nil)) 6999 (while entries 7000 (while (and entries (< cnt N)) 7001 (setq cnt (1+ cnt) 7002 nextmenu (cons (car entries) nextmenu) 7003 entries (cdr entries))) 7004 (setq nextmenu (nreverse nextmenu)) 7005 (prin1 nextmenu) 7006 (setq nextmenu (cons (format "%s...%s" 7007 (car (car nextmenu)) 7008 (car (nth (1- cnt) nextmenu))) 7009 nextmenu)) 7010 (setq menu (cons nextmenu menu) 7011 nextmenu nil 7012 cnt 0)) 7013 (setq menu (nreverse menu)) 7014 (setq menu (cons title menu)) 7015 menu))) 7016 7017(defvar idlwave-completion-setup-hook nil) 7018 7019(defun idlwave-scroll-completions (&optional message) 7020 "Scroll the completion window on this frame." 7021 (let ((cwin (get-buffer-window "*Completions*" 'visible)) 7022 (win (selected-window))) 7023 (unwind-protect 7024 (progn 7025 (select-window cwin) 7026 (condition-case nil 7027 (scroll-up) 7028 (error (if (and (listp last-command) 7029 (nth 2 last-command)) 7030 (progn 7031 (select-window win) 7032 (eval idlwave-complete-after-success-form)) 7033 (set-window-start cwin (point-min))))) 7034 (and message (message message))) 7035 (select-window win)))) 7036 7037(defun idlwave-display-completion-list (list &optional message beg complete) 7038 "Display the completions in LIST in the completions buffer and echo MESSAGE." 7039 (unless (and (get-buffer-window "*Completions*") 7040 (idlwave-local-value 'idlwave-completion-p "*Completions*")) 7041 (move-marker idlwave-completion-mark beg) 7042 (setq idlwave-before-completion-wconf (current-window-configuration))) 7043 7044 (if (featurep 'xemacs) 7045 (idlwave-display-completion-list-xemacs 7046 list) 7047 (idlwave-display-completion-list-emacs list)) 7048 7049 ;; Store a special value in `this-command'. When `idlwave-complete' 7050 ;; finds this in `last-command', it will scroll the *Completions* buffer. 7051 (setq this-command (list 'idlwave-display-completion-list message complete)) 7052 7053 ;; Mark the completions buffer as created by cib 7054 (idlwave-set-local 'idlwave-completion-p t "*Completions*") 7055 7056 ;; Fontify the classes 7057 (if (and idlwave-completion-fontify-classes 7058 (consp (car list))) 7059 (idlwave-completion-fontify-classes)) 7060 7061 ;; Run the hook 7062 (run-hooks 'idlwave-completion-setup-hook) 7063 7064 ;; Display the message 7065 (message (or message "Making completion list...done"))) 7066 7067(defun idlwave-choose (function &rest args) 7068 "Call FUNCTION as a completion chooser and pass ARGS to it." 7069 (let ((completion-ignore-case t)) ; install correct value 7070 (apply function args)) 7071 (if (and (eq major-mode 'idlwave-shell-mode) 7072 (boundp 'font-lock-mode) 7073 (not font-lock-mode)) 7074 ;; For the shell, remove the fontification of the word before point 7075 (let ((beg (save-excursion 7076 (skip-chars-backward "a-zA-Z0-9_") 7077 (point)))) 7078 (remove-text-properties beg (point) '(face nil)))) 7079 (eval idlwave-complete-after-success-form-force)) 7080 7081(defun idlwave-keyboard-quit () 7082 (interactive) 7083 (unwind-protect 7084 (if (eq (car-safe last-command) 'idlwave-display-completion-list) 7085 (idlwave-restore-wconf-after-completion)) 7086 (keyboard-quit))) 7087 7088(defun idlwave-restore-wconf-after-completion () 7089 "Restore the old (before completion) window configuration." 7090 (and idlwave-completion-restore-window-configuration 7091 idlwave-before-completion-wconf 7092 (set-window-configuration idlwave-before-completion-wconf))) 7093 7094(defun idlwave-one-key-select (sym prompt delay) 7095 "Make the user select an element from the alist in the variable SYM. 7096The keys of the alist are expected to be strings. The function returns the 7097car of the selected association. 7098To do this, PROMPT is displayed and and the user must hit a letter key to 7099select an entry. If the user does not reply within DELAY seconds, a help 7100window with the options is displayed automatically. 7101The key which is associated with each option is generated automatically. 7102First, the strings are checked for preselected keys, like in \"[P]rint\". 7103If these don't exist, a letter in the string is automatically selected." 7104 (let* ((alist (symbol-value sym)) 7105 (temp-buffer-show-hook (if (fboundp 'fit-window-to-buffer) 7106 '(fit-window-to-buffer))) 7107 keys-alist char) 7108 ;; First check the cache 7109 (if (and (eq (symbol-value sym) (get sym :one-key-alist-last))) 7110 (setq keys-alist (get sym :one-key-alist-cache)) 7111 ;; Need to make new list 7112 (setq keys-alist (idlwave-make-one-key-alist alist)) 7113 (put sym :one-key-alist-cache keys-alist) 7114 (put sym :one-key-alist-last alist)) 7115 ;; Display prompt and wait for quick reply 7116 (message "%s[%s]" prompt 7117 (mapconcat (lambda(x) (char-to-string (car x))) 7118 keys-alist "")) 7119 (if (sit-for delay) 7120 ;; No quick reply: Show help 7121 (save-window-excursion 7122 (with-output-to-temp-buffer "*Completions*" 7123 (mapcar (lambda(x) 7124 (princ (nth 1 x)) 7125 (princ "\n")) 7126 keys-alist)) 7127 (setq char (read-char))) 7128 (setq char (read-char))) 7129 (message nil) 7130 ;; Return the selected result 7131 (nth 2 (assoc char keys-alist)))) 7132 7133;; Used for, e.g., electric debug super-examine. 7134(defun idlwave-make-one-key-alist (alist) 7135 "Make an alist for single key selection." 7136 (let ((l alist) keys-alist name start char help 7137 (cnt 0) 7138 (case-fold-search nil)) 7139 (while l 7140 (setq name (car (car l)) 7141 l (cdr l)) 7142 (catch 'exit 7143 ;; First check if the configuration predetermined a key 7144 (if (string-match "\\[\\(.\\)\\]" name) 7145 (progn 7146 (setq char (string-to-char (downcase (match-string 1 name))) 7147 help (format "%c: %s" char name) 7148 keys-alist (cons (list char help name) keys-alist)) 7149 (throw 'exit t))) 7150 ;; Then check for capital letters 7151 (setq start 0) 7152 (while (string-match "[A-Z]" name start) 7153 (setq start (match-end 0) 7154 char (string-to-char (downcase (match-string 0 name)))) 7155 (if (not (assoc char keys-alist)) 7156 (progn 7157 (setq help (format "%c: %s" char 7158 (replace-match 7159 (concat "[" (match-string 0 name) "]") 7160 t t name)) 7161 keys-alist (cons (list char help name) keys-alist)) 7162 (throw 'exit t)))) 7163 ;; Now check for lowercase letters 7164 (setq start 0) 7165 (while (string-match "[a-z]" name start) 7166 (setq start (match-end 0) 7167 char (string-to-char (match-string 0 name))) 7168 (if (not (assoc char keys-alist)) 7169 (progn 7170 (setq help (format "%c: %s" char 7171 (replace-match 7172 (concat "[" (match-string 0 name) "]") 7173 t t name)) 7174 keys-alist (cons (list char help name) keys-alist)) 7175 (throw 'exit t)))) 7176 ;; Bummer, nothing found! Use a stupid number 7177 (setq char (string-to-char (int-to-string (setq cnt (1+ cnt)))) 7178 help (format "%c: %s" char name) 7179 keys-alist (cons (list char help name) keys-alist)))) 7180 (nreverse keys-alist))) 7181 7182(defun idlwave-set-local (var value &optional buffer) 7183 "Set the buffer-local value of VAR in BUFFER to VALUE." 7184 (save-excursion 7185 (set-buffer (or buffer (current-buffer))) 7186 (set (make-local-variable var) value))) 7187 7188(defun idlwave-local-value (var &optional buffer) 7189 "Return the value of VAR in BUFFER, but only if VAR is local to BUFFER." 7190 (save-excursion 7191 (set-buffer (or buffer (current-buffer))) 7192 (and (local-variable-p var (current-buffer)) 7193 (symbol-value var)))) 7194 7195;; In XEmacs, we can use :activate-callback directly to advice the 7196;; choose functions. We use the private keymap only for the online 7197;; help feature. 7198 7199(defvar idlwave-completion-map nil 7200 "Keymap for completion-list-mode with idlwave-complete.") 7201 7202(defun idlwave-display-completion-list-xemacs (list &rest cl-args) 7203 (with-output-to-temp-buffer "*Completions*" 7204 (apply 'display-completion-list list 7205 ':activate-callback 'idlwave-default-choose-completion 7206 cl-args)) 7207 (save-excursion 7208 (set-buffer "*Completions*") 7209 (use-local-map 7210 (or idlwave-completion-map 7211 (setq idlwave-completion-map 7212 (idlwave-make-modified-completion-map-xemacs 7213 (current-local-map))))))) 7214 7215(defun idlwave-default-choose-completion (&rest args) 7216 "Execute `default-choose-completion' and then restore the win-conf." 7217 (apply 'idlwave-choose 'default-choose-completion args)) 7218 7219(defun idlwave-make-modified-completion-map-xemacs (old-map) 7220 "Replace `choose-completion' and `mouse-choose-completion' in OLD-MAP." 7221 (let ((new-map (copy-keymap old-map))) 7222 (define-key new-map [button3up] 'idlwave-mouse-completion-help) 7223 (define-key new-map [button3] (lambda () 7224 (interactive) 7225 (setq this-command last-command))) 7226 new-map)) 7227 7228;; In Emacs we also replace keybindings in the completion 7229;; map in order to install our wrappers. 7230 7231(defun idlwave-display-completion-list-emacs (list) 7232 "Display completion list and install the choose wrappers." 7233 (with-output-to-temp-buffer "*Completions*" 7234 (display-completion-list list)) 7235 (save-excursion 7236 (set-buffer "*Completions*") 7237 (use-local-map 7238 (or idlwave-completion-map 7239 (setq idlwave-completion-map 7240 (idlwave-make-modified-completion-map-emacs 7241 (current-local-map))))))) 7242 7243(defun idlwave-make-modified-completion-map-emacs (old-map) 7244 "Replace `choose-completion' and `mouse-choose-completion' in OLD-MAP." 7245 (let ((new-map (copy-keymap old-map))) 7246 (substitute-key-definition 7247 'choose-completion 'idlwave-choose-completion new-map) 7248 (substitute-key-definition 7249 'mouse-choose-completion 'idlwave-mouse-choose-completion new-map) 7250 (define-key new-map [mouse-3] 'idlwave-mouse-completion-help) 7251 new-map)) 7252 7253(defun idlwave-choose-completion (&rest args) 7254 "Choose the completion that point is in or next to." 7255 (interactive) 7256 (apply 'idlwave-choose 'choose-completion args)) 7257 7258(defun idlwave-mouse-choose-completion (&rest args) 7259 "Click on an alternative in the `*Completions*' buffer to choose it." 7260 (interactive "e") 7261 (apply 'idlwave-choose 'mouse-choose-completion args)) 7262 7263;;---------------------------------------------------------------------- 7264;;---------------------------------------------------------------------- 7265 7266;;; ------------------------------------------------------------------------ 7267;;; Stucture parsing code, and code to manage class info 7268 7269;; 7270;; - Go again over the documentation how to write a completion 7271;; plugin. It is in self.el, but currently still very bad. 7272;; This could be in a separate file in the distribution, or 7273;; in an appendix for the manual. 7274 7275(defvar idlwave-struct-skip 7276 "[ \t]*\\(\\$.*\n\\(^[ \t]*\\(\\$[ \t]*\\)?\\(;.*\\)?\n\\)*\\)?[ \t]*" 7277 "Regexp for skipping continued blank or comment-only lines in 7278structures") 7279 7280(defvar idlwave-struct-tag-regexp 7281 (concat "[{,]" ;leading comma/brace 7282 idlwave-struct-skip ; 4 groups 7283 "\\([a-zA-Z][a-zA-Z0-9_]*\\)" ;the tag itself, group 5 7284 "[ \t]*:") ; the final colon 7285 "Regexp for structure tags.") 7286 7287(defun idlwave-struct-tags () 7288 "Return a list of all tags in the structure defined at point. 7289Point is expected just before the opening `{' of the struct definition." 7290 (save-excursion 7291 (let* ((borders (idlwave-struct-borders)) 7292 (beg (car borders)) 7293 (end (cdr borders)) 7294 tags) 7295 (goto-char beg) 7296 (save-restriction 7297 (narrow-to-region beg end) 7298 (while (re-search-forward idlwave-struct-tag-regexp end t) 7299 ;; Check if we are still on the top level of the structure. 7300 (if (and (condition-case nil (progn (up-list -1) t) (error nil)) 7301 (= (point) beg)) 7302 (push (match-string-no-properties 5) tags)) 7303 (goto-char (match-end 0)))) 7304 (nreverse tags)))) 7305 7306(defun idlwave-find-struct-tag (tag) 7307 "Find a given TAG in the structure defined at point." 7308 (let* ((borders (idlwave-struct-borders)) 7309 (beg (car borders)) 7310 (end (cdr borders)) 7311 (case-fold-search t)) 7312 (re-search-forward (concat "\\(^[ \t]*\\|[,{][ \t]*\\)" tag "[ \t]*:") 7313 end t))) 7314 7315(defun idlwave-struct-inherits () 7316 "Return a list of all `inherits' names in the struct at point. 7317Point is expected just before the opening `{' of the struct definition." 7318 (save-excursion 7319 (let* ((borders (idlwave-struct-borders)) 7320 (beg (car borders)) 7321 (end (cdr borders)) 7322 (case-fold-search t) 7323 names) 7324 (goto-char beg) 7325 (save-restriction 7326 (narrow-to-region beg end) 7327 (while (re-search-forward 7328 (concat "[{,]" ;leading comma/brace 7329 idlwave-struct-skip ; 4 groups 7330 "inherits" ; The INHERITS tag 7331 idlwave-struct-skip ; 4 more 7332 "\\([a-zA-Z][a-zA-Z0-9_]*\\)") ; The super-group, #9 7333 end t) 7334 ;; Check if we are still on the top level of the structure. 7335 (if (and (condition-case nil (progn (up-list -1) t) (error nil)) 7336 (= (point) beg)) 7337 (push (match-string-no-properties 9) names)) 7338 (goto-char (match-end 0)))) 7339 (nreverse names)))) 7340 7341(defun idlwave-in-structure () 7342 "Return t if point is inside an IDL structure definition." 7343 (let ((beg (point))) 7344 (save-excursion 7345 (if (not (or (idlwave-in-comment) (idlwave-in-quote))) 7346 (if (idlwave-find-structure-definition nil nil 'back) 7347 (let ((borders (idlwave-struct-borders))) 7348 (or (= (car borders) (cdr borders)) ;; struct not yet closed... 7349 (and (> beg (car borders)) (< beg (cdr borders)))))))))) 7350 7351(defun idlwave-struct-borders () 7352 "Return the borders of the {...} after point as a cons cell." 7353 (let (beg) 7354 (save-excursion 7355 (skip-chars-forward "^{") 7356 (setq beg (point)) 7357 (condition-case nil (forward-list 1) 7358 (error (goto-char beg))) 7359 (cons beg (point))))) 7360 7361(defun idlwave-find-structure-definition (&optional var name bound) 7362 "Search forward for a structure definition. If VAR is non-nil, 7363search for a structure assigned to variable VAR. If NAME is non-nil, 7364search for a named structure NAME, if a string, or a generic named 7365structure otherwise. If BOUND is an integer, limit the search. If 7366BOUND is the symbol `all', we search first back and then forward 7367through the entire file. If BOUND is the symbol `back' we search only 7368backward." 7369 (let* ((ws "[ \t]*\\(\\$.*\n[ \t]*\\)*") 7370 (case-fold-search t) 7371 (lim (if (integerp bound) bound nil)) 7372 (re (concat 7373 (if var 7374 (concat "\\<" (regexp-quote (downcase var)) "\\>" ws) 7375 "\\(\\)") 7376 "=" ws "\\({\\)" 7377 (if name 7378 (if (stringp name) 7379 (concat ws "\\(\\<" (downcase name) "\\)[^a-zA-Z0-9_$]") 7380 ;; Just a generic name 7381 (concat ws "\\<\\([a-zA-Z_0-9$]+\\)" ws ",")) 7382 "")))) 7383 (if (or (and (or (eq bound 'all) (eq bound 'back)) 7384 (re-search-backward re nil t)) 7385 (and (not (eq bound 'back)) (re-search-forward re lim t))) 7386 (progn 7387 (goto-char (match-beginning 3)) 7388 (match-string-no-properties 5))))) 7389 7390(defvar idlwave-class-info nil) 7391(defvar idlwave-class-reset nil) ; to reset buffer-local classes 7392 7393(add-hook 'idlwave-update-rinfo-hook 7394 (lambda () (setq idlwave-class-reset t))) 7395(add-hook 'idlwave-after-load-rinfo-hook 7396 (lambda () (setq idlwave-class-info nil))) 7397 7398(defun idlwave-class-info (class) 7399 (let (list entry) 7400 (if idlwave-class-info 7401 (if idlwave-class-reset 7402 (setq 7403 idlwave-class-reset nil 7404 idlwave-class-info ; Remove any visited in a buffer 7405 (delq nil (mapcar 7406 (lambda (x) 7407 (let ((filebuf 7408 (idlwave-class-file-or-buffer 7409 (or (cdr (assq 'found-in x)) (car x))))) 7410 (if (cdr filebuf) 7411 nil 7412 x))) 7413 idlwave-class-info)))) 7414 ;; Info is nil, put in the system stuff to start. 7415 (setq idlwave-class-info idlwave-system-class-info) 7416 (setq list idlwave-class-info) 7417 (while (setq entry (pop list)) 7418 (idlwave-sintern-class-info entry))) 7419 (setq class (idlwave-sintern-class class)) 7420 (or (assq class idlwave-class-info) 7421 (progn (idlwave-scan-class-info class) 7422 (assq class idlwave-class-info))))) 7423 7424(defun idlwave-sintern-class-info (entry) 7425 "Sintern the class names in a class-info entry." 7426 (let ((taglist (assq 'tags entry)) 7427 (inherits (assq 'inherits entry))) 7428 (setcar entry (idlwave-sintern-class (car entry) 'set)) 7429 (if inherits 7430 (setcdr inherits (mapcar (lambda (x) (idlwave-sintern-class x 'set)) 7431 (cdr inherits)))))) 7432 7433(defun idlwave-find-class-definition (class &optional all-hook alt-class) 7434 "Find class structure definition(s) 7435If ALL-HOOK is set, find all named structure definitions in a given 7436class__define routine, on which ALL-HOOK will be run. If ALT-CLASS is 7437set, look for the name__define pro, and inside of it, for the ALT-CLASS 7438class/struct definition" 7439 (let ((case-fold-search t) end-lim list name) 7440 (when (re-search-forward 7441 (concat "^[ \t]*pro[ \t]+" (downcase class) "__define" "\\>") nil t) 7442 (if all-hook 7443 (progn 7444 ;; For everything there 7445 (setq end-lim (save-excursion (idlwave-end-of-subprogram) (point))) 7446 (while (setq name 7447 (idlwave-find-structure-definition nil t end-lim)) 7448 (funcall all-hook name))) 7449 (idlwave-find-structure-definition nil (or alt-class class)))))) 7450 7451 7452(defun idlwave-class-file-or-buffer (class) 7453 "Find buffer visiting CLASS definition" 7454 (let* ((pro (concat (downcase class) "__define")) 7455 (file (idlwave-routine-source-file 7456 (nth 3 (idlwave-rinfo-assoc pro 'pro nil 7457 (idlwave-routines)))))) 7458 (cons file (if file (idlwave-get-buffer-visiting file))))) 7459 7460 7461(defun idlwave-scan-class-info (class) 7462 "Scan all class and named structure info in the class__define pro" 7463 (let* ((idlwave-auto-routine-info-updates nil) 7464 (filebuf (idlwave-class-file-or-buffer class)) 7465 (file (car filebuf)) 7466 (buf (cdr filebuf)) 7467 (class (idlwave-sintern-class class))) 7468 (if (or 7469 (not file) 7470 (and ;; neither a regular file nor a visited buffer 7471 (not buf) 7472 (not (file-regular-p file)))) 7473 nil ; Cannot find the file/buffer to get any info 7474 (save-excursion 7475 (if buf (set-buffer buf) 7476 ;; Read the file in temporarily 7477 (set-buffer (get-buffer-create " *IDLWAVE-tmp*")) 7478 (erase-buffer) 7479 (unless (eq major-mode 'idlwave-mode) 7480 (idlwave-mode)) 7481 (insert-file-contents file)) 7482 (save-excursion 7483 (goto-char 1) 7484 (idlwave-find-class-definition class 7485 ;; Scan all of the structures found there 7486 (lambda (name) 7487 (let* ((this-class (idlwave-sintern-class name)) 7488 (entry 7489 (list this-class 7490 (cons 'tags (idlwave-struct-tags)) 7491 (cons 'inherits (idlwave-struct-inherits))))) 7492 (if (not (eq this-class class)) 7493 (setq entry (nconc entry (list (cons 'found-in class))))) 7494 (idlwave-sintern-class-info entry) 7495 (push entry idlwave-class-info))))))))) 7496 7497(defun idlwave-class-found-in (class) 7498 "Return the FOUND-IN property of the class." 7499 (cdr (assq 'found-in (idlwave-class-info class)))) 7500(defun idlwave-class-tags (class) 7501 "Return the native tags in CLASS." 7502 (cdr (assq 'tags (idlwave-class-info class)))) 7503(defun idlwave-class-inherits (class) 7504 "Return the direct superclasses of CLASS." 7505 (cdr (assq 'inherits (idlwave-class-info class)))) 7506 7507 7508(defun idlwave-all-class-tags (class) 7509 "Return a list of native and inherited tags in CLASS." 7510 (condition-case err 7511 (apply 'append (mapcar 'idlwave-class-tags 7512 (cons class (idlwave-all-class-inherits class)))) 7513 (error 7514 (idlwave-class-tag-reset) 7515 (error "%s" (error-message-string err))))) 7516 7517 7518(defun idlwave-all-class-inherits (class) 7519 "Return a list of all superclasses of CLASS (recursively expanded). 7520The list is cached in `idlwave-class-info' for faster access." 7521 (cond 7522 ((not idlwave-support-inheritance) nil) 7523 ((eq class nil) nil) 7524 ((eq class t) nil) 7525 (t 7526 (let ((info (idlwave-class-info class)) 7527 entry) 7528 (if (setq entry (assq 'all-inherits info)) 7529 (cdr entry) 7530 ;; Save the depth of inheritance scan to check for circular references 7531 (let ((inherits (mapcar (lambda (x) (cons x 0)) 7532 (idlwave-class-inherits class))) 7533 rtn all-inherits cl) 7534 (while inherits 7535 (setq cl (pop inherits) 7536 rtn (cons (car cl) rtn) 7537 inherits (append (mapcar (lambda (x) 7538 (cons x (1+ (cdr cl)))) 7539 (idlwave-class-inherits (car cl))) 7540 inherits)) 7541 (if (> (cdr cl) 999) 7542 (error 7543 "Class scan: inheritance depth exceeded. Circular inheritance?") 7544 )) 7545 (setq all-inherits (nreverse rtn)) 7546 (nconc info (list (cons 'all-inherits all-inherits))) 7547 all-inherits)))))) 7548 7549(defun idlwave-entry-keywords (entry &optional record-link) 7550 "Return the flat entry keywords alist from routine-info entry. 7551If RECORD-LINK is non-nil, the keyword text is copied and a text 7552property indicating the link is added." 7553 (let (kwds) 7554 (mapcar 7555 (lambda (key-list) 7556 (let ((file (car key-list))) 7557 (mapcar (lambda (key-cons) 7558 (let ((key (car key-cons)) 7559 (link (cdr key-cons))) 7560 (when (and record-link file) 7561 (setq key (copy-sequence key)) 7562 (put-text-property 7563 0 (length key) 7564 'link 7565 (concat 7566 file 7567 (if link 7568 (concat idlwave-html-link-sep 7569 (number-to-string link)))) 7570 key)) 7571 (push (list key) kwds))) 7572 (cdr key-list)))) 7573 (nthcdr 5 entry)) 7574 (nreverse kwds))) 7575 7576(defun idlwave-entry-find-keyword (entry keyword) 7577 "Find keyword KEYWORD in entry ENTRY, and return (with link) if set" 7578 (catch 'exit 7579 (mapc 7580 (lambda (key-list) 7581 (let ((file (car key-list)) 7582 (kwd (assoc keyword (cdr key-list)))) 7583 (when kwd 7584 (setq kwd (cons (car kwd) 7585 (if (and file (cdr kwd)) 7586 (concat file 7587 idlwave-html-link-sep 7588 (number-to-string (cdr kwd))) 7589 (cdr kwd)))) 7590 (throw 'exit kwd)))) 7591 (nthcdr 5 entry)))) 7592 7593;;========================================================================== 7594;; 7595;; Completing class structure tags. This is a completion plugin. 7596;; The necessary taglist is constructed dynamically 7597 7598(defvar idlwave-current-tags-class nil) 7599(defvar idlwave-current-class-tags nil) 7600(defvar idlwave-current-native-class-tags nil) 7601(defvar idlwave-sint-class-tags nil) 7602(idlwave-new-sintern-type 'class-tag) 7603(add-to-list 'idlwave-complete-special 'idlwave-complete-class-structure-tag) 7604(add-hook 'idlwave-update-rinfo-hook 'idlwave-class-tag-reset) 7605 7606(defun idlwave-complete-class-structure-tag () 7607 "Complete a structure tag on a `self' argument in an object method." 7608 (interactive) 7609 (let ((pos (point)) 7610 (case-fold-search t)) 7611 (if (save-excursion 7612 ;; Check if the context is right 7613 (skip-chars-backward "a-zA-Z0-9._$") 7614 (and (< (point) (- pos 4)) 7615 (looking-at "self\\."))) 7616 (let* ((class-selector (nth 2 (idlwave-current-routine))) 7617 (super-classes (idlwave-all-class-inherits class-selector))) 7618 ;; Check if we are in a class routine 7619 (unless class-selector 7620 (error "Not in a method procedure or function")) 7621 ;; Check if we need to update the "current" class 7622 (if (not (equal class-selector idlwave-current-tags-class)) 7623 (idlwave-prepare-class-tag-completion class-selector)) 7624 (setq idlwave-completion-help-info 7625 (list 'idlwave-complete-class-structure-tag-help 7626 (idlwave-sintern-routine 7627 (concat class-selector "__define")) 7628 nil)) 7629 (let ((idlwave-cpl-bold idlwave-current-native-class-tags)) 7630 (idlwave-complete-in-buffer 7631 'class-tag 'class-tag 7632 idlwave-current-class-tags nil 7633 (format "Select a tag of class %s" class-selector) 7634 "class tag" 7635 'idlwave-attach-class-tag-classes)) 7636 t) ; return t to skip other completions 7637 nil))) 7638 7639(defun idlwave-class-tag-reset () 7640 (setq idlwave-current-tags-class nil)) 7641 7642(defun idlwave-prepare-class-tag-completion (class) 7643 "Find and parse the necessary class definitions for class structure tags." 7644 (setq idlwave-sint-class-tags nil) 7645 (setq idlwave-current-tags-class class) 7646 (setq idlwave-current-class-tags 7647 (mapcar (lambda (x) 7648 (list (idlwave-sintern-class-tag x 'set))) 7649 (idlwave-all-class-tags class))) 7650 (setq idlwave-current-native-class-tags 7651 (mapcar 'downcase (idlwave-class-tags class)))) 7652 7653;=========================================================================== 7654;; 7655;; Completing system variables and their structure fields 7656;; This is also a plugin. 7657 7658(defvar idlwave-sint-sysvars nil) 7659(defvar idlwave-sint-sysvartags nil) 7660(idlwave-new-sintern-type 'sysvar) 7661(idlwave-new-sintern-type 'sysvartag) 7662(add-to-list 'idlwave-complete-special 'idlwave-complete-sysvar-or-tag) 7663(add-hook 'idlwave-update-rinfo-hook 'idlwave-sysvars-reset) 7664(add-hook 'idlwave-after-load-rinfo-hook 'idlwave-sintern-sysvar-alist) 7665 7666 7667(defun idlwave-complete-sysvar-or-tag () 7668 "Complete a system variable." 7669 (interactive) 7670 (let ((pos (point)) 7671 (case-fold-search t)) 7672 (cond ((save-excursion 7673 ;; Check if the context is right for system variable 7674 (skip-chars-backward "[a-zA-Z0-9_$]") 7675 (equal (char-before) ?!)) 7676 (setq idlwave-completion-help-info '(idlwave-complete-sysvar-help)) 7677 (idlwave-complete-in-buffer 'sysvar 'sysvar 7678 idlwave-system-variables-alist nil 7679 "Select a system variable" 7680 "system variable") 7681 t) ; return t to skip other completions 7682 ((save-excursion 7683 ;; Check if the context is right for sysvar tag 7684 (skip-chars-backward "a-zA-Z0-9_$.") 7685 (and (equal (char-before) ?!) 7686 (looking-at "\\([a-zA-Z][a-zA-Z0-9_$]*\\)\\.") 7687 (<= (match-end 0) pos))) 7688 ;; Complete a system variable tag 7689 (let* ((var (idlwave-sintern-sysvar (match-string 1))) 7690 (entry (assq var idlwave-system-variables-alist)) 7691 (tags (cdr (assq 'tags entry)))) 7692 (or entry (error "!%s is not a known system variable" var)) 7693 (or tags (error "System variable !%s is not a structure" var)) 7694 (setq idlwave-completion-help-info 7695 (list 'idlwave-complete-sysvar-tag-help var)) 7696 (idlwave-complete-in-buffer 'sysvartag 'sysvartag 7697 tags nil 7698 "Select a system variable tag" 7699 "system variable tag") 7700 t)) ; return t to skip other completions 7701 (t nil)))) 7702 7703(defvar link) ;dynamic variables set by help callback 7704(defvar props) 7705(defun idlwave-complete-sysvar-help (mode word) 7706 (let ((word (or (nth 1 idlwave-completion-help-info) word)) 7707 (entry (assoc word idlwave-system-variables-alist))) 7708 (cond 7709 ((eq mode 'test) 7710 (and (stringp word) entry (nth 1 (assq 'link entry)))) 7711 ((eq mode 'set) 7712 (if entry (setq link (nth 1 (assq 'link entry))))) ;; setting dynamic!!! 7713 (t (error "This should not happen"))))) 7714 7715(defun idlwave-complete-sysvar-tag-help (mode word) 7716 (let* ((var (nth 1 idlwave-completion-help-info)) 7717 (entry (assoc var idlwave-system-variables-alist)) 7718 (tags (cdr (assq 'tags entry))) 7719 (main (nth 1 (assq 'link entry))) 7720 target main-base) 7721 (cond 7722 ((eq mode 'test) ; we can at least link the main 7723 (and (stringp word) entry main)) 7724 ((eq mode 'set) 7725 (if entry 7726 (setq link 7727 (if (setq target (cdr (assoc-string word tags t))) 7728 (idlwave-substitute-link-target main target) 7729 main)))) ;; setting dynamic!!! 7730 (t (error "This should not happen"))))) 7731 7732(defun idlwave-split-link-target (link) 7733 "Split a given link into link file and anchor." 7734 (if (string-match idlwave-html-link-sep link) 7735 (cons (substring link 0 (match-beginning 0)) 7736 (string-to-number (substring link (match-end 0)))))) 7737 7738(defun idlwave-substitute-link-target (link target) 7739 "Substitute the target anchor for the given link." 7740 (let (main-base) 7741 (setq main-base (if (string-match "#" link) 7742 (substring link 0 (match-beginning 0)) 7743 link)) 7744 (if target 7745 (concat main-base idlwave-html-link-sep (number-to-string target)) 7746 link))) 7747 7748;; Fake help in the source buffer for class structure tags. 7749;; KWD AND NAME ARE GLOBAL-VARIABLES HERE. 7750(defvar name) 7751(defvar kwd) 7752(defvar idlwave-help-do-class-struct-tag nil) 7753(defun idlwave-complete-class-structure-tag-help (mode word) 7754 (cond 7755 ((eq mode 'test) ; nothing gets fontified for class tags 7756 nil) 7757 ((eq mode 'set) 7758 (let (class-with found-in) 7759 (when (setq class-with 7760 (idlwave-class-or-superclass-with-tag 7761 idlwave-current-tags-class 7762 word)) 7763 (if (assq (idlwave-sintern-class class-with) 7764 idlwave-system-class-info) 7765 (error "No help available for system class tags")) 7766 (if (setq found-in (idlwave-class-found-in class-with)) 7767 (setq name (cons (concat found-in "__define") class-with)) 7768 (setq name (concat class-with "__define"))))) 7769 (setq kwd word 7770 idlwave-help-do-class-struct-tag t)) 7771 (t (error "This should not happen")))) 7772 7773(defun idlwave-class-or-superclass-with-tag (class tag) 7774 "Find and return the CLASS or one of its superclass with the 7775associated TAG, if any." 7776 (let ((sclasses (cons class (idlwave-all-class-inherits class))) 7777 cl) 7778 (catch 'exit 7779 (while sclasses 7780 (setq cl (pop sclasses)) 7781 (let ((tags (idlwave-class-tags cl))) 7782 (while tags 7783 (if (eq t (compare-strings tag 0 nil (car tags) 0 nil t)) 7784 (throw 'exit cl)) 7785 (setq tags (cdr tags)))))))) 7786 7787 7788(defun idlwave-sysvars-reset () 7789 (if (and (fboundp 'idlwave-shell-is-running) 7790 (idlwave-shell-is-running) 7791 idlwave-idlwave_routine_info-compiled) 7792 (idlwave-shell-send-command "idlwave_get_sysvars" 7793 'idlwave-process-sysvars 'hide))) 7794 7795(defun idlwave-process-sysvars () 7796 (idlwave-shell-filter-sysvars) 7797 (setq idlwave-sint-sysvars nil 7798 idlwave-sint-sysvartags nil) 7799 (idlwave-sintern-sysvar-alist)) 7800 7801(defun idlwave-sintern-sysvar-alist () 7802 (let ((list idlwave-system-variables-alist) entry tags) 7803 (while (setq entry (pop list)) 7804 (setcar entry (idlwave-sintern-sysvar (car entry) 'set)) 7805 (setq tags (assq 'tags entry)) 7806 (if tags 7807 (setcdr tags 7808 (mapcar (lambda (x) 7809 (cons (idlwave-sintern-sysvartag (car x) 'set) 7810 (cdr x))) 7811 (cdr tags))))))) 7812 7813(defvar idlwave-shell-command-output) 7814(defun idlwave-shell-filter-sysvars () 7815 "Get any new system variables and tags." 7816 (let ((text idlwave-shell-command-output) 7817 (start 0) 7818 (old idlwave-system-variables-alist) 7819 var tags type name class link old-entry) 7820 (setq idlwave-system-variables-alist nil) 7821 (while (string-match "^IDLWAVE-SYSVAR: !\\([a-zA-Z0-9_$]+\\)\\( \\(.*\\)\\)?" 7822 text start) 7823 (setq start (match-end 0) 7824 var (match-string 1 text) 7825 tags (if (match-end 3) 7826 (idlwave-split-string (match-string 3 text)))) 7827 ;; Maintain old links, if present 7828 (setq old-entry (assq (idlwave-sintern-sysvar var) old)) 7829 (setq link (assq 'link old-entry)) 7830 (setq idlwave-system-variables-alist 7831 (cons (list var 7832 (cons 7833 'tags 7834 (mapcar (lambda (x) 7835 (cons x 7836 (cdr (assq 7837 (idlwave-sintern-sysvartag x) 7838 (cdr (assq 'tags old-entry)))))) 7839 tags)) link) 7840 idlwave-system-variables-alist))) 7841 ;; Keep the old value if query was not successful 7842 (setq idlwave-system-variables-alist 7843 (or idlwave-system-variables-alist old)))) 7844 7845(defun idlwave-completion-fontify-classes () 7846 "Goto the *Completions* buffer and fontify the class info." 7847 (when (featurep 'font-lock) 7848 (save-excursion 7849 (set-buffer "*Completions*") 7850 (save-excursion 7851 (goto-char (point-min)) 7852 (let ((buffer-read-only nil)) 7853 (while (re-search-forward "\\.*<[^>]+>" nil t) 7854 (put-text-property (match-beginning 0) (match-end 0) 7855 'face 'font-lock-string-face))))))) 7856 7857(defun idlwave-uniquify (list) 7858 (let ((ht (make-hash-table :size (length list) :test 'equal))) 7859 (delq nil 7860 (mapcar (lambda (x) 7861 (unless (gethash x ht) 7862 (puthash x t ht) 7863 x)) 7864 list)))) 7865 7866(defun idlwave-after-successful-completion (type slash &optional verify) 7867 "Add `=' or `(' after successful completion of keyword and function. 7868Restore the pre-completion window configuration if possible." 7869 (cond 7870 ((eq type 'procedure) 7871 nil) 7872 ((eq type 'function) 7873 (cond 7874 ((equal idlwave-function-completion-adds-paren nil) nil) 7875 ((or (equal idlwave-function-completion-adds-paren t) 7876 (equal idlwave-function-completion-adds-paren 1)) 7877 (insert "(")) 7878 ((equal idlwave-function-completion-adds-paren 2) 7879 (insert "()") 7880 (backward-char 1)) 7881 (t nil))) 7882 ((eq type 'keyword) 7883 (if (and idlwave-keyword-completion-adds-equal 7884 (not slash)) 7885 (progn (insert "=") t) 7886 nil))) 7887 7888 ;; Restore the pre-completion window configuration if this is safe. 7889 7890 (if (or (eq verify 'force) ; force 7891 (and 7892 (get-buffer-window "*Completions*") ; visible 7893 (idlwave-local-value 'idlwave-completion-p 7894 "*Completions*") ; cib-buffer 7895 (eq (marker-buffer idlwave-completion-mark) 7896 (current-buffer)) ; buffer OK 7897 (equal (marker-position idlwave-completion-mark) 7898 verify))) ; pos OK 7899 (idlwave-restore-wconf-after-completion)) 7900 (move-marker idlwave-completion-mark nil) 7901 (setq idlwave-before-completion-wconf nil)) 7902 7903(defun idlwave-mouse-context-help (ev &optional arg) 7904 "Call `idlwave-context-help' on the clicked location." 7905 (interactive "eP") 7906 (mouse-set-point ev) 7907 (idlwave-context-help arg)) 7908 7909(defvar idlwave-last-context-help-pos nil) 7910(defun idlwave-context-help (&optional arg) 7911 "Display IDL Online Help on context. 7912If point is on a keyword, help for that keyword will be shown. If 7913point is on a routine name or in the argument list of a routine, help 7914for that routine will be displayed. Works for system routines and 7915keywords, it pulls up text help. For other routies and keywords, 7916visits the source file, finding help in the header (if 7917`idlwave-help-source-try-header' is non-nil) or the routine definition 7918itself." 7919 (interactive "P") 7920 (idlwave-do-context-help arg)) 7921 7922(defun idlwave-mouse-completion-help (ev) 7923 "Display online help about the completion at point." 7924 (interactive "eP") 7925 ;; Restore last-command for next command, to make 7926 ;; scrolling/cancelling of completions work. 7927 (setq this-command last-command) 7928 (idlwave-do-mouse-completion-help ev)) 7929 7930(defun idlwave-routine-info (&optional arg external) 7931 "Display a routines calling sequence and list of keywords. When 7932point is on the name a function or procedure, or in the argument list 7933of a function or procedure, this command displays a help buffer with 7934the information. When called with prefix arg, enforce class query. 7935 7936When point is on an object operator `->', display the class stored in 7937this arrow, if any (see `idlwave-store-inquired-class'). With a 7938prefix arg, the class property is cleared out." 7939 7940 (interactive "P") 7941 (idlwave-routines) 7942 (if (string-match "->" (buffer-substring 7943 (max (point-min) (1- (point))) 7944 (min (+ 2 (point)) (point-max)))) 7945 ;; Cursor is on an arrow 7946 (if (get-text-property (point) 'idlwave-class) 7947 ;; arrow has class property 7948 (if arg 7949 ;; Remove property 7950 (save-excursion 7951 (backward-char 1) 7952 (when (looking-at ".?\\(->\\)") 7953 (remove-text-properties (match-beginning 1) (match-end 1) 7954 '(idlwave-class nil face nil)) 7955 (message "Class property removed from arrow"))) 7956 ;; Echo class property 7957 (message "Arrow has text property identifying object to be class %s" 7958 (get-text-property (point) 'idlwave-class))) 7959 ;; No property found 7960 (message "Arrow has no class text property")) 7961 7962 ;; Not on an arrow... 7963 (let* ((idlwave-query-class nil) 7964 (idlwave-force-class-query (equal arg '(4))) 7965 (module (idlwave-what-module))) 7966 (if (car module) 7967 (apply 'idlwave-display-calling-sequence 7968 (idlwave-fix-module-if-obj_new module)) 7969 (error "Don't know which calling sequence to show"))))) 7970 7971(defun idlwave-resolve (&optional arg) 7972 "Call RESOLVE_ROUTINE on the module name at point. 7973Like `idlwave-routine-info', this looks for a routine call at point. 7974After confirmation in the minibuffer, it will use the shell to issue 7975a RESOLVE call for this routine, to attempt to make it defined and its 7976routine info available for IDLWAVE. If the routine is a method call, 7977both `class__method' and `class__define' will be tried. 7978With ARG, enforce query for the class of object methods." 7979 (interactive "P") 7980 (let* ((idlwave-query-class nil) 7981 (idlwave-force-class-query (equal arg '(4))) 7982 (module (idlwave-what-module)) 7983 (name (idlwave-make-full-name (nth 2 module) (car module))) 7984 (type (if (eq (nth 1 module) 'pro) "pro" "function")) 7985 (resolve (read-string "Resolve: " (format "%s %s" type name))) 7986 (kwd "") 7987 class) 7988 (if (string-match "\\(pro\\|function\\)[ \t]+\\(\\(.*\\)::\\)?\\(.*\\)" 7989 resolve) 7990 (setq type (match-string 1 resolve) 7991 class (if (match-beginning 2) 7992 (match-string 3 resolve) 7993 nil) 7994 name (match-string 4 resolve))) 7995 (if (string= (downcase type) "function") 7996 (setq kwd ",/is_function")) 7997 7998 (cond 7999 ((null class) 8000 (idlwave-shell-send-command 8001 (format "resolve_routine,'%s'%s" (downcase name) kwd) 8002 'idlwave-update-routine-info 8003 nil t)) 8004 (t 8005 (idlwave-shell-send-command 8006 (format "resolve_routine,'%s__define'%s" (downcase class) kwd) 8007 (list 'idlwave-shell-send-command 8008 (format "resolve_routine,'%s__%s'%s" 8009 (downcase class) (downcase name) kwd) 8010 '(idlwave-update-routine-info) 8011 nil t)))))) 8012 8013(defun idlwave-find-module-this-file () 8014 (interactive) 8015 (idlwave-find-module '(4))) 8016 8017(defun idlwave-find-module (&optional arg) 8018 "Find the source code of an IDL module. 8019Works for modules for which IDLWAVE has routine info available. The 8020function offers as default the module name `idlwave-routine-info' 8021would use. With ARG limit to this buffer. With two prefix ARG's 8022force class query for object methods." 8023 (interactive "P") 8024 (let* ((idlwave-query-class nil) 8025 (idlwave-force-class-query (equal arg '(16))) 8026 (this-buffer (equal arg '(4))) 8027 (module (idlwave-fix-module-if-obj_new (idlwave-what-module))) 8028 (default (if module 8029 (concat (idlwave-make-full-name 8030 (nth 2 module) (car module)) 8031 (if (eq (nth 1 module) 'pro) "<p>" "<f>")) 8032 "none")) 8033 (list 8034 (idlwave-uniquify 8035 (delq nil 8036 (mapcar (lambda (x) 8037 (if (eq 'system (car-safe (nth 3 x))) 8038 ;; Take out system routines with no source. 8039 nil 8040 (list 8041 (concat (idlwave-make-full-name 8042 (nth 2 x) (car x)) 8043 (if (eq (nth 1 x) 'pro) "<p>" "<f>"))))) 8044 (if this-buffer 8045 (idlwave-save-buffer-update) 8046 (idlwave-routines)))))) 8047 (name (idlwave-completing-read 8048 (if (or (not this-buffer) 8049 (assoc default list)) 8050 (format "Module (Default %s): " default) 8051 (format "Module in this file: ")) 8052 list)) 8053 type class) 8054 (if (string-match "\\`\\s-*\\'" name) 8055 ;; Nothing, use the default. 8056 (setq name default)) 8057 (if (string-match "<[fp]>" name) 8058 (setq type (substring name -2 -1) 8059 name (substring name 0 -3))) 8060 (if (string-match "\\(.*\\)::\\(.*\\)" name) 8061 (setq class (match-string 1 name) 8062 name (match-string 2 name))) 8063 (setq name (idlwave-sintern-routine-or-method name class) 8064 class (idlwave-sintern-class class) 8065 type (cond ((equal type "f") 'fun) 8066 ((equal type "p") 'pro) 8067 (t t))) 8068 (idlwave-do-find-module name type class nil this-buffer))) 8069 8070(defun idlwave-do-find-module (name type class 8071 &optional force-source this-buffer) 8072 (let ((name1 (idlwave-make-full-name class name)) 8073 source buf1 entry 8074 (buf (current-buffer)) 8075 (pos (point)) 8076 file name2) 8077 (setq entry (idlwave-best-rinfo-assq name type class (idlwave-routines) 8078 'WITH-FILE) 8079 source (or force-source (nth 3 entry)) 8080 name2 (if (nth 2 entry) 8081 (idlwave-make-full-name (nth 2 entry) name) 8082 name1)) 8083 (if source 8084 (setq file (idlwave-routine-source-file source))) 8085 (unless file ; Try to find it on the path. 8086 (setq file 8087 (idlwave-expand-lib-file-name 8088 (if class 8089 (format "%s__define.pro" (downcase class)) 8090 (format "%s.pro" (downcase name)))))) 8091 (cond 8092 ((or (null name) (equal name "")) 8093 (error "Abort")) 8094 ((eq (car source) 'system) 8095 (error "Source code for system routine %s is not available" 8096 name2)) 8097 ((or (not file) (not (file-regular-p file))) 8098 (error "Source code for routine %s is not available" 8099 name2)) 8100 (t 8101 (when (not this-buffer) 8102 (setq buf1 8103 (idlwave-find-file-noselect file 'find)) 8104 (pop-to-buffer buf1 t)) 8105 (goto-char (point-max)) 8106 (let ((case-fold-search t)) 8107 (if (re-search-backward 8108 (concat "^[ \t]*\\<" 8109 (cond ((eq type 'fun) "function") 8110 ((eq type 'pro) "pro") 8111 (t "\\(pro\\|function\\)")) 8112 "\\>[ \t]+" 8113 (regexp-quote (downcase name2)) 8114 "[^a-zA-Z0-9_$]") 8115 nil t) 8116 (goto-char (match-beginning 0)) 8117 (pop-to-buffer buf) 8118 (goto-char pos) 8119 (error "Could not find routine %s" name2))))))) 8120 8121(defun idlwave-what-module () 8122 "Return a default module for stuff near point. 8123Used by `idlwave-routine-info' and `idlwave-find-module'." 8124 (idlwave-routines) 8125 (if (let ((case-fold-search t)) 8126 (save-excursion 8127 (idlwave-beginning-of-statement) 8128 (looking-at "[ \t]*\\(pro\\|function\\)[ \t]+\\(\\([a-zA-Z0-9_$]+\\)::\\)?\\([a-zA-Z0-9$_]+\\)\\([, \t\n]\\|$\\)"))) 8129 ;; This is a function or procedure definition statement 8130 ;; We return the defined routine as module. 8131 (list 8132 (idlwave-sintern-routine-or-method (match-string-no-properties 4) 8133 (match-string-no-properties 2)) 8134 (if (equal (downcase (match-string 1)) "pro") 'pro 'fun) 8135 (idlwave-sintern-class (match-string 3))) 8136 8137 ;; Not a definition statement - analyze precise position. 8138 (let* ((where (idlwave-where)) 8139 (cw (nth 2 where)) 8140 (pro (car (nth 0 where))) 8141 (func (car (nth 1 where))) 8142 (this-word (idlwave-this-word "a-zA-Z0-9$_")) 8143 (next-char (save-excursion (skip-chars-forward "a-zA-Z0-9$_") 8144 (following-char))) 8145 ) 8146 (cond 8147 ((and (eq cw 'procedure) 8148 (not (equal this-word ""))) 8149 (setq this-word (idlwave-sintern-routine-or-method 8150 this-word (nth 2 (nth 3 where)))) 8151 (list this-word 'pro 8152 (idlwave-determine-class 8153 (cons this-word (cdr (nth 3 where))) 8154 'pro))) 8155 ((and (eq cw 'function) 8156 (not (equal this-word "")) 8157 (or (eq next-char ?\() ; exclude arrays, vars. 8158 (looking-at "[a-zA-Z0-9_]*[ \t]*("))) 8159 (setq this-word (idlwave-sintern-routine-or-method 8160 this-word (nth 2 (nth 3 where)))) 8161 (list this-word 'fun 8162 (idlwave-determine-class 8163 (cons this-word (cdr (nth 3 where))) 8164 'fun))) 8165 ((and (memq cw '(function-keyword procedure-keyword)) 8166 (not (equal this-word "")) 8167 (eq next-char ?\()) ; A function! 8168 (setq this-word (idlwave-sintern-routine this-word)) 8169 (list this-word 'fun nil)) 8170 (func 8171 (list func 'fun (idlwave-determine-class (nth 1 where) 'fun))) 8172 (pro 8173 (list pro 'pro (idlwave-determine-class (nth 0 where) 'pro))) 8174 (t nil))))) 8175 8176(defun idlwave-what-module-find-class () 8177 "Call idlwave-what-module and find the inherited class if necessary." 8178 (let* ((module (idlwave-what-module)) 8179 (class (nth 2 module)) 8180 classes) 8181 (if (and (= (length module) 3) 8182 (stringp class)) 8183 (list (car module) 8184 (nth 1 module) 8185 (apply 'idlwave-find-inherited-class module)) 8186 module))) 8187 8188(defun idlwave-find-inherited-class (name type class) 8189 "Find the class which defines TYPE NAME and is CLASS or inherited by CLASS." 8190 (let ((entry (idlwave-best-rinfo-assoc name type class (idlwave-routines)))) 8191 (if entry 8192 (nth 2 entry) 8193 class))) 8194 8195(defun idlwave-fix-module-if-obj_new (module) 8196 "Check if MODULE points to obj_new. 8197If yes, and if the cursor is in the keyword region, change to the 8198appropriate Init method." 8199 (let* ((name (car module)) 8200 (pos (point)) 8201 (case-fold-search t) 8202 string) 8203 (if (and (stringp name) 8204 (equal (downcase name) "obj_new") 8205 (save-excursion 8206 (idlwave-beginning-of-statement) 8207 (setq string (buffer-substring (point) pos)) 8208 (string-match "obj_new([^'\"]*['\"]\\([a-zA-Z0-9_]+\\)" 8209 string))) 8210 (let ((name "Init") 8211 (class (match-string 1 string))) 8212 (setq module (list (idlwave-sintern-method "Init") 8213 'fun 8214 (idlwave-sintern-class class))))) 8215 module)) 8216 8217(defun idlwave-fix-keywords (name type class keywords 8218 &optional super-classes system) 8219 "Update a list of keywords. 8220Translate OBJ_NEW, adding all super-class keywords, or all keywords 8221from all classes if class equals t. If SYSTEM is non-nil, don't 8222demand _EXTRA in the keyword list." 8223 (let ((case-fold-search t)) 8224 8225 ;; If this is the OBJ_NEW function, try to figure out the class and use 8226 ;; the keywords from the corresponding INIT method. 8227 (if (and (equal (upcase name) "OBJ_NEW") 8228 (or (eq major-mode 'idlwave-mode) 8229 (eq major-mode 'idlwave-shell-mode))) 8230 (let* ((bos (save-excursion (idlwave-beginning-of-statement) (point))) 8231 (string (buffer-substring bos (point))) 8232 (case-fold-search t) 8233 class) 8234 (and (string-match "obj_new([^'\"]*['\"]\\([a-zA-Z0-9_]+\\)" 8235 string) 8236 (setq class (idlwave-sintern-class (match-string 1 string))) 8237 (setq idlwave-current-obj_new-class class) 8238 (setq keywords 8239 (append keywords 8240 (idlwave-entry-keywords 8241 (idlwave-rinfo-assq 8242 (idlwave-sintern-method "INIT") 8243 'fun 8244 class 8245 (idlwave-routines)) 'do-link)))))) 8246 8247 ;; If the class is `t', combine all keywords of all methods NAME 8248 (when (eq class t) 8249 (mapc (lambda (entry) 8250 (and 8251 (nth 2 entry) ; non-nil class 8252 (eq (nth 1 entry) type) ; correct type 8253 (setq keywords 8254 (append keywords 8255 (idlwave-entry-keywords entry 'do-link))))) 8256 (idlwave-all-assq name (idlwave-routines))) 8257 (setq keywords (idlwave-uniquify keywords))) 8258 8259 ;; If we have inheritance, add all keywords from superclasses, if 8260 ;; the user indicated that method in `idlwave-keyword-class-inheritance' 8261 (when (and 8262 super-classes 8263 idlwave-keyword-class-inheritance 8264 (stringp class) 8265 (or 8266 system 8267 (assq (idlwave-sintern-keyword "_extra") keywords) 8268 (assq (idlwave-sintern-keyword "_ref_extra") keywords)) 8269 ;; Check if one of the keyword-class regexps matches the name 8270 (let ((regexps idlwave-keyword-class-inheritance) re) 8271 (catch 'exit 8272 (while (setq re (pop regexps)) 8273 (if (string-match re name) (throw 'exit t)))))) 8274 8275 (loop for entry in (idlwave-routines) do 8276 (and (nth 2 entry) ; non-nil class 8277 (memq (nth 2 entry) super-classes) ; an inherited class 8278 (eq (nth 1 entry) type) ; correct type 8279 (eq (car entry) name) ; correct name 8280 (mapcar (lambda (k) (add-to-list 'keywords k)) 8281 (idlwave-entry-keywords entry 'do-link)))) 8282 (setq keywords (idlwave-uniquify keywords))) 8283 8284 ;; Return the final list 8285 keywords)) 8286 8287(defun idlwave-expand-keyword (keyword module) 8288 "Expand KEYWORD to one of the valid keyword parameters of MODULE. 8289KEYWORD may be an exact match or an abbreviation of a keyword. 8290If the match is exact, KEYWORD itself is returned, even if there may be other 8291keywords of which KEYWORD is an abbreviation. This is necessary because some 8292system routines have keywords which are prefixes of other keywords. 8293If KEYWORD is an abbreviation of several keywords, a list of all possible 8294completions is returned. 8295If the abbreviation was unique, the correct keyword is returned. 8296If it cannot be a keyword, the function return nil. 8297If we do not know about MODULE, just return KEYWORD literally." 8298 (let* ((name (car module)) 8299 (type (nth 1 module)) 8300 (class (nth 2 module)) 8301 (kwd (idlwave-sintern-keyword keyword)) 8302 (entry (idlwave-best-rinfo-assoc name type class (idlwave-routines))) 8303 (kwd-alist (idlwave-entry-keywords entry)) 8304 (extra (or (assq (idlwave-sintern-keyword "_EXTRA") kwd-alist) 8305 (assq (idlwave-sintern-keyword "_REF_EXTRA") kwd-alist))) 8306 (completion-ignore-case t) 8307 candidates) 8308 (cond ((assq kwd kwd-alist) 8309 kwd) 8310 ((setq candidates (all-completions kwd kwd-alist)) 8311 (if (= (length candidates) 1) 8312 (car candidates) 8313 candidates)) 8314 ((and entry extra) 8315 ;; Inheritance may cause this keyword to be correct 8316 keyword) 8317 (entry 8318 ;; We do know the function, which does not have the keyword. 8319 nil) 8320 (t 8321 ;; We do not know the function, so this just might be a correct 8322 ;; keyword - return it as it is. 8323 keyword)))) 8324 8325(defvar idlwave-rinfo-mouse-map (make-sparse-keymap)) 8326(defvar idlwave-rinfo-map (make-sparse-keymap)) 8327(define-key idlwave-rinfo-mouse-map 8328 (if (featurep 'xemacs) [button2] [mouse-2]) 8329 'idlwave-mouse-active-rinfo) 8330(define-key idlwave-rinfo-mouse-map 8331 (if (featurep 'xemacs) [(shift button2)] [(shift mouse-2)]) 8332 'idlwave-mouse-active-rinfo-shift) 8333(define-key idlwave-rinfo-mouse-map 8334 (if (featurep 'xemacs) [button3] [mouse-3]) 8335 'idlwave-mouse-active-rinfo-right) 8336(define-key idlwave-rinfo-mouse-map " " 'idlwave-active-rinfo-space) 8337(define-key idlwave-rinfo-map "q" 'idlwave-quit-help) 8338(define-key idlwave-rinfo-mouse-map "q" 'idlwave-quit-help) 8339(defvar idlwave-popup-source nil) 8340(defvar idlwave-rinfo-marker (make-marker)) 8341 8342(defun idlwave-quit-help () 8343 (interactive) 8344 (let ((ri-window (get-buffer-window "*Help*")) 8345 (olh-window (get-buffer-window "*IDLWAVE Help*"))) 8346 (when (and olh-window 8347 (fboundp 'idlwave-help-quit)) 8348 (select-window olh-window) 8349 (idlwave-help-quit)) 8350 (when (window-live-p ri-window) 8351 (delete-window ri-window)))) 8352 8353(defun idlwave-display-calling-sequence (name type class 8354 &optional initial-class) 8355 ;; Display the calling sequence of module NAME, type TYPE in class CLASS. 8356 (let* ((initial-class (or initial-class class)) 8357 (entry (or (idlwave-best-rinfo-assq name type class 8358 (idlwave-routines)) 8359 (idlwave-rinfo-assq name type class 8360 idlwave-unresolved-routines))) 8361 (name (or (car entry) name)) 8362 (class (or (nth 2 entry) class)) 8363 (superclasses (idlwave-all-class-inherits initial-class)) 8364 (twins (idlwave-routine-twins entry)) 8365 (dtwins (idlwave-study-twins twins)) 8366 (all dtwins) 8367 (system (eq (car (nth 3 entry)) 'system)) 8368 (calling-seq (nth 4 entry)) 8369 (keywords (idlwave-entry-keywords entry 'do-link)) 8370 (html-file (car (nth 5 entry))) 8371 (help-echo-kwd 8372 "Button2: Insert KEYWORD (SHIFT=`/KEYWORD') | Button3: Online Help ") 8373 (help-echo-use 8374 "Button2/3: Online Help") 8375 (help-echo-src 8376 "Button2: Jump to source and back | Button3: Source in Help window.") 8377 (help-echo-class 8378 "Button2: Display info about same method in superclass") 8379 (col 0) 8380 (data (list name type class (current-buffer) nil initial-class)) 8381 (km-prop (if (featurep 'xemacs) 'keymap 'local-map)) 8382 (face 'idlwave-help-link) 8383 beg props win cnt total) 8384 ;; Fix keywords, but don't add chained super-classes, since these 8385 ;; are shown separately for that super-class 8386 (setq keywords (idlwave-fix-keywords name type class keywords)) 8387 (cond 8388 ((null entry) 8389 (error "No %s %s known %s" type name 8390 (if initial-class (concat "in class " initial-class) ""))) 8391 ((or (null name) (equal name "")) 8392 (error "No function or procedure call at point")) 8393 ((null calling-seq) 8394 (error "Calling sequence of %s %s not available" type name)) 8395 (t 8396 (save-excursion 8397 (move-marker idlwave-rinfo-marker (point)) 8398 (set-buffer (get-buffer-create "*Help*")) 8399 (use-local-map idlwave-rinfo-map) 8400 (setq buffer-read-only nil) 8401 (erase-buffer) 8402 (set (make-local-variable 'idlwave-popup-source) nil) 8403 (set (make-local-variable 'idlwave-current-obj_new-class) 8404 idlwave-current-obj_new-class) 8405 (when superclasses 8406 (setq props (list 'mouse-face 'highlight 8407 km-prop idlwave-rinfo-mouse-map 8408 'help-echo help-echo-class 8409 'data (cons 'class data))) 8410 (let ((classes (cons initial-class superclasses)) c) 8411 (insert "Classes: ") 8412 (while (setq c (pop classes)) 8413 (insert " ") 8414 (setq beg (point)) 8415 (insert c) 8416 (if (equal (downcase c) (downcase class)) 8417 (add-text-properties beg (point) (list 'face 'bold)) 8418 ;; If Method exists in a different class link it 8419 (if (idlwave-rinfo-assq name type c (idlwave-routines)) 8420 (add-text-properties beg (point) props)))) 8421 (insert "\n"))) 8422 (setq props (list 'mouse-face 'highlight 8423 km-prop idlwave-rinfo-mouse-map 8424 'help-echo help-echo-use 8425 'data (cons 'usage data))) 8426 (if html-file (setq props (append (list 'face face 'link html-file) 8427 props))) 8428 (insert "Usage: ") 8429 (setq beg (point)) 8430 (insert (if class 8431 (format calling-seq class name class name class name) 8432 (format calling-seq name name name name)) 8433 "\n") 8434 (add-text-properties beg (point) props) 8435 8436 (insert "Keywords:") 8437 (if (null keywords) 8438 (insert " No keywords accepted.") 8439 (setq col 9) 8440 (mapcar 8441 (lambda (x) 8442 (if (>= (+ col 1 (length (car x))) 8443 (window-width)) 8444 (progn 8445 (insert "\n ") 8446 (setq col 9))) 8447 (insert " ") 8448 (setq beg (point) 8449 ;; Relevant keywords already have link property attached 8450 props (list 'mouse-face 'highlight 8451 km-prop idlwave-rinfo-mouse-map 8452 'data (cons 'keyword data) 8453 'help-echo help-echo-kwd 8454 'keyword (car x))) 8455 (if system (setq props (append (list 'face face) props))) 8456 (insert (car x)) 8457 (add-text-properties beg (point) props) 8458 (setq col (+ col 1 (length (car x))))) 8459 keywords)) 8460 8461 (setq cnt 1 total (length all)) 8462 ;; Here entry is (key file (list of type-conses)) 8463 (while (setq entry (pop all)) 8464 (setq props (list 'mouse-face 'highlight 8465 km-prop idlwave-rinfo-mouse-map 8466 'help-echo help-echo-src 8467 'source (list (car (car (nth 2 entry))) ;type 8468 (nth 1 entry) 8469 nil 8470 (cdr (car (nth 2 entry)))) 8471 'data (cons 'source data))) 8472 (idlwave-insert-source-location 8473 (format "\n%-8s %s" 8474 (if (equal cnt 1) 8475 (if (> total 1) "Sources:" "Source:") 8476 "") 8477 (if (> total 1) "- " "")) 8478 entry props) 8479 (incf cnt) 8480 (when (and all (> cnt idlwave-rinfo-max-source-lines)) 8481 ;; No more source lines, please 8482 (insert (format 8483 "\n Source information truncated to %d entries." 8484 idlwave-rinfo-max-source-lines)) 8485 (setq all nil))) 8486 (goto-char (point-min)) 8487 (setq buffer-read-only t)) 8488 (display-buffer "*Help*") 8489 (if (and (setq win (get-buffer-window "*Help*")) 8490 idlwave-resize-routine-help-window) 8491 (progn 8492 (let ((ww (selected-window))) 8493 (unwind-protect 8494 (progn 8495 (select-window win) 8496 (enlarge-window (- (/ (frame-height) 2) 8497 (window-height))) 8498 (shrink-window-if-larger-than-buffer)) 8499 (select-window ww))))))))) 8500 8501(defun idlwave-insert-source-location (prefix entry &optional file-props) 8502 "Insert a source location into the routine info buffer. 8503Start line with PREFIX. If a file name is inserted, add FILE-PROPS to 8504it." 8505 (let* ((key (car entry)) 8506 (file (nth 1 entry)) 8507 (types (nth 2 entry)) 8508 (shell-flag (assq 'compiled types)) 8509 (buffer-flag (assq 'buffer types)) 8510 (user-flag (assq 'user types)) 8511 (lib-flag (assq 'lib types)) 8512 (ndupl (or (and buffer-flag (idlwave-count-memq 'buffer types)) 8513 (and user-flag (idlwave-count-memq 'user types)) 8514 (and lib-flag (idlwave-count-memq 'lib types)) 8515 1)) 8516 (doflags t) 8517 beg special) 8518 8519 (insert prefix) 8520 8521 (cond 8522 ((eq key 'system) 8523 (setq doflags nil) 8524 (insert "System ")) 8525 8526 ((eq key 'builtin) 8527 (setq doflags nil) 8528 (insert "Builtin ")) 8529 8530 ((and (not file) shell-flag) 8531 (insert "Unresolved")) 8532 8533 ((null file) 8534 (insert "ERROR")) 8535 8536 ((idlwave-syslib-p file) 8537 (if (string-match "obsolete" (file-name-directory file)) 8538 (insert "Obsolete ") 8539 (insert "SystemLib "))) 8540 8541 ;; New special syntax: taken directly from routine-info for 8542 ;; library catalog routines 8543 ((setq special (or (cdr lib-flag) (cdr user-flag))) 8544 (insert (format "%-10s" special))) 8545 8546 ;; Old special syntax: a matching regexp 8547 ((setq special (idlwave-special-lib-test file)) 8548 (insert (format "%-10s" special))) 8549 8550 ;; Catch-all with file 8551 ((idlwave-lib-p file) (insert "Library ")) 8552 8553 ;; Sanity catch all 8554 (t (insert "Other "))) 8555 8556 (when doflags 8557 (insert (concat 8558 " [" 8559 (if lib-flag "L" "-") 8560 (if user-flag "C" "-") 8561 (if shell-flag "S" "-") 8562 (if buffer-flag "B" "-") 8563 "] "))) 8564 (when (> ndupl 1) 8565 (setq beg (point)) 8566 (insert (format "(%dx) " ndupl)) 8567 (add-text-properties beg (point) (list 'face 'bold))) 8568 (when (and file (not (equal file ""))) 8569 (setq beg (point)) 8570 (insert (apply 'abbreviate-file-name 8571 (if (featurep 'xemacs) (list file t) (list file)))) 8572 (if file-props 8573 (add-text-properties beg (point) file-props))))) 8574 8575(defun idlwave-special-lib-test (file) 8576 "Check the path of FILE against the regexps which define special libs. 8577Return the name of the special lib if there is a match." 8578 (let ((alist idlwave-special-lib-alist) 8579 entry rtn) 8580 (cond 8581 ((stringp file) 8582 (while (setq entry (pop alist)) 8583 (if (string-match (car entry) file) 8584 (setq rtn (cdr entry) 8585 alist nil))) 8586 rtn) 8587 (t nil)))) 8588 8589(defun idlwave-mouse-active-rinfo-right (ev) 8590 (interactive "e") 8591 (idlwave-mouse-active-rinfo ev 'right)) 8592 8593(defun idlwave-mouse-active-rinfo-shift (ev) 8594 (interactive "e") 8595 (idlwave-mouse-active-rinfo ev nil 'shift)) 8596 8597(defun idlwave-active-rinfo-space () 8598 (interactive) 8599 (idlwave-mouse-active-rinfo nil 'right)) 8600 8601(defun idlwave-mouse-active-rinfo (ev &optional right shift) 8602 "Does the mouse actions in the routine info buffer. 8603Optional args RIGHT and SHIFT indicate, if mouse-3 was used, and if SHIFT 8604was pressed." 8605 (interactive "e") 8606 (if ev (mouse-set-point ev)) 8607 (let (data id name type class buf bufwin source link keyword 8608 word initial-class) 8609 (setq data (get-text-property (point) 'data) 8610 source (get-text-property (point) 'source) 8611 keyword (get-text-property (point) 'keyword) 8612 link (get-text-property (point) 'link) 8613 id (car data) 8614 name (nth 1 data) type (nth 2 data) class (nth 3 data) 8615 buf (nth 4 data) 8616 initial-class (nth 6 data) 8617 word (idlwave-this-word) 8618 bufwin (get-buffer-window buf t)) 8619 8620 (cond ((eq id 'class) ; Switch class being displayed 8621 (if (window-live-p bufwin) (select-window bufwin)) 8622 (idlwave-display-calling-sequence 8623 (idlwave-sintern-method name) 8624 type (idlwave-sintern-class word) 8625 initial-class)) 8626 ((eq id 'usage) ; Online help on this routine 8627 (idlwave-online-help link name type class)) 8628 ((eq id 'source) ; Source in help or buffer 8629 (if right ; In help 8630 (let ((idlwave-extra-help-function 'idlwave-help-with-source) 8631 (idlwave-help-source-try-header nil) 8632 ;; Fake idlwave-routines so help will find the right entry 8633 (idlwave-routines 8634 (list (list name type class source "")))) 8635 (idlwave-help-get-special-help name type class nil)) 8636 ;; Otherwise just pop to the source 8637 (setq idlwave-popup-source (not idlwave-popup-source)) 8638 (if idlwave-popup-source 8639 (condition-case err 8640 (idlwave-do-find-module name type class source) 8641 (error 8642 (setq idlwave-popup-source nil) 8643 (if (window-live-p bufwin) (select-window bufwin)) 8644 (error (nth 1 err)))) 8645 (if bufwin 8646 (select-window bufwin) 8647 (pop-to-buffer buf)) 8648 (goto-char (marker-position idlwave-rinfo-marker))))) 8649 ((eq id 'keyword) 8650 (if right 8651 (idlwave-online-help link name type class keyword) 8652 (idlwave-rinfo-insert-keyword keyword buf shift)))))) 8653 8654(defun idlwave-rinfo-insert-keyword (keyword buffer &optional shift) 8655 "Insert KEYWORD in BUFFER. Make sure buffer is displayed in a window." 8656 (let ((bwin (get-buffer-window buffer))) 8657 (if idlwave-complete-empty-string-as-lower-case 8658 (setq keyword (downcase keyword))) 8659 (if bwin 8660 (select-window bwin) 8661 (pop-to-buffer buffer) 8662 (setq bwin (get-buffer-window buffer))) 8663 (if (eq (preceding-char) ?/) 8664 (insert keyword) 8665 (unless (save-excursion 8666 (re-search-backward 8667 "[(,][ \t]*\\(\\$[ \t]*\\(;.*\\)?\n\\)?[ \t]*\\=" 8668 (min (- (point) 100) (point-min)) t)) 8669 (insert ", ")) 8670 (if shift (insert "/")) 8671 (insert keyword) 8672 (if (and (not shift) 8673 idlwave-keyword-completion-adds-equal) 8674 (insert "="))))) 8675 8676(defun idlwave-list-buffer-load-path-shadows (&optional arg) 8677 "List the load path shadows of all routines defined in current buffer." 8678 (interactive "P") 8679 (idlwave-routines) 8680 (if (eq major-mode 'idlwave-mode) 8681 (idlwave-list-load-path-shadows 8682 nil (idlwave-update-current-buffer-info 'save-buffer) 8683 "in current buffer") 8684 (error "Current buffer is not in idlwave-mode"))) 8685 8686(defun idlwave-list-shell-load-path-shadows (&optional arg) 8687 "List the load path shadows of all routines compiled under the shell. 8688This is very useful for checking an IDL application. Just compile the 8689application, do RESOLVE_ALL, and `C-c C-i' to compile all referenced 8690routines and update IDLWAVE internal info. Then check for shadowing 8691with this command." 8692 (interactive "P") 8693 (cond 8694 ((or (not (fboundp 'idlwave-shell-is-running)) 8695 (not (idlwave-shell-is-running))) 8696 (error "Shell is not running")) 8697 ((null idlwave-compiled-routines) 8698 (error "No compiled routines. Maybe you need to update with `C-c C-i'")) 8699 (t 8700 (idlwave-list-load-path-shadows nil idlwave-compiled-routines 8701 "in the shell")))) 8702 8703(defun idlwave-list-all-load-path-shadows (&optional arg) 8704 "List the load path shadows of all routines known to IDLWAVE." 8705 (interactive "P") 8706 (idlwave-list-load-path-shadows nil nil "globally")) 8707 8708(defun idlwave-list-load-path-shadows (arg &optional special-routines loc) 8709 "List the routines which are defined multiple times. 8710Search the information IDLWAVE has about IDL routines for multiple 8711definitions. 8712When SPECIAL-ROUTINES in non-nil, only look for shadows of these routines. 8713 8714When IDL hits a routine call which is not defined, it will search on 8715the load path in order to find a definition. The output of this 8716command can be used to detect possible name clashes during this process." 8717 (idlwave-routines) ; Make sure everything is loaded. 8718 (unless (or idlwave-user-catalog-routines idlwave-library-catalog-routines) 8719 (or (y-or-n-p 8720 "You don't have any user or library catalogs. Continue anyway? ") 8721 (error "Abort"))) 8722 (let* ((routines (append idlwave-system-routines 8723 idlwave-compiled-routines 8724 idlwave-library-catalog-routines 8725 idlwave-user-catalog-routines 8726 idlwave-buffer-routines 8727 nil)) 8728 (km-prop (if (featurep 'xemacs) 'keymap 'local-map)) 8729 (keymap (make-sparse-keymap)) 8730 (props (list 'mouse-face 'highlight 8731 km-prop keymap 8732 'help-echo "Mouse2: Find source")) 8733 (nroutines (length (or special-routines routines))) 8734 (step (/ nroutines 100)) 8735 (n 0) 8736 (cnt 0) 8737 (idlwave-sort-prefer-buffer-info nil) 8738 routine twins dtwins twin done props1 lroutines) 8739 8740 (if special-routines 8741 ;; Just looking for shadows of a few special routines 8742 (setq lroutines routines 8743 routines special-routines)) 8744 8745 (message "Sorting routines...") 8746 (setq routines (sort routines 8747 (lambda (a b) 8748 (string< (downcase (idlwave-make-full-name 8749 (nth 2 a) (car a))) 8750 (downcase (idlwave-make-full-name 8751 (nth 2 b) (car b))))))) 8752 (message "Sorting routines...done") 8753 8754 (define-key keymap (if (featurep 'xemacs) [(button2)] [(mouse-2)]) 8755 (lambda (ev) 8756 (interactive "e") 8757 (mouse-set-point ev) 8758 (apply 'idlwave-do-find-module 8759 (get-text-property (point) 'find-args)))) 8760 (define-key keymap [(return)] 8761 (lambda () 8762 (interactive) 8763 (apply 'idlwave-do-find-module 8764 (get-text-property (point) 'find-args)))) 8765 (message "Compiling list...( 0%%)") 8766 (save-excursion 8767 (set-buffer (get-buffer-create "*Shadows*")) 8768 (setq buffer-read-only nil) 8769 (erase-buffer) 8770 (while (setq routine (pop routines)) 8771 (if (= (mod (setq n (1+ n)) step) 0) 8772 (message "Compiling list...(%2d%%)" (/ (* n 100) nroutines))) 8773 8774 ;; Get a list of all twins 8775 (setq twins (idlwave-routine-twins routine (or lroutines routines))) 8776 (if (memq routine done) 8777 (setq dtwins nil) 8778 (setq dtwins (idlwave-study-twins twins))) 8779 ;; Mark all twins as dealt with 8780 (setq done (append twins done)) 8781 (when (or (> (length dtwins) 1) 8782 (> (idlwave-count-memq 'lib (nth 2 (car dtwins))) 1) 8783 (> (idlwave-count-memq 'user (nth 2 (car dtwins))) 1) 8784 (> (idlwave-count-memq 'buffer (nth 2 (car dtwins))) 1)) 8785 (incf cnt) 8786 (insert (format "\n%s%s" 8787 (idlwave-make-full-name (nth 2 routine) 8788 (car routine)) 8789 (if (eq (nth 1 routine) 'fun) "()" ""))) 8790 (while (setq twin (pop dtwins)) 8791 (setq props1 (append (list 'find-args 8792 (list (nth 0 routine) 8793 (nth 1 routine) 8794 (nth 2 routine))) 8795 props)) 8796 (idlwave-insert-source-location "\n - " twin props1)))) 8797 (goto-char (point-min)) 8798 (setq buffer-read-only t)) 8799 (setq loc (or loc "")) 8800 (if (> cnt 0) 8801 (progn 8802 (display-buffer (get-buffer "*Shadows*")) 8803 (message "%d case%s of shadowing found %s" 8804 cnt (if (= cnt 1) "" "s") loc)) 8805 (message "No shadowing conflicts found %s" loc)))) 8806 8807(defun idlwave-print-source (routine) 8808 (let* ((source (nth 3 routine)) 8809 (stype (car source)) 8810 (sfile (idlwave-routine-source-file source))) 8811 (if (idlwave-syslib-p sfile) (setq stype 'syslib)) 8812 (if (and (eq stype 'compiled) 8813 (or (not (stringp sfile)) 8814 (not (string-match "\\S-" sfile)))) 8815 (setq stype 'unresolved)) 8816 (princ (format " %-10s %s\n" 8817 stype 8818 (if sfile sfile "No source code available"))))) 8819 8820(defun idlwave-routine-twins (entry &optional list) 8821 "Return all twin entries of ENTRY in LIST. 8822LIST defaults to `idlwave-routines'. 8823Twin entries are those which have the same name, type, and class. 8824ENTRY will also be returned, as the first item of this list." 8825 (let* ((name (car entry)) 8826 (type (nth 1 entry)) 8827 (class (nth 2 entry)) 8828 (candidates (idlwave-all-assq name (or list (idlwave-routines)))) 8829 twins candidate) 8830 (while (setq candidate (pop candidates)) 8831 (if (and (not (eq candidate entry)) 8832 (eq type (nth 1 candidate)) 8833 (eq class (nth 2 candidate))) 8834 (push candidate twins))) 8835 (if (setq candidate (idlwave-rinfo-assq name type class 8836 idlwave-unresolved-routines)) 8837 (push candidate twins)) 8838 (cons entry (nreverse twins)))) 8839 8840(defun idlwave-study-twins (entries) 8841 "Return dangerous twins of first entry in ENTRIES. 8842Dangerous twins are routines with same name, but in different files on 8843the load path. If a file is in the system library and has an entry in 8844the `idlwave-system-routines' list, we omit the latter as 8845non-dangerous because many IDL routines are implemented as library 8846routines, and may have been scanned." 8847 (let* ((entry (car entries)) 8848 (name (car entry)) ; 8849 (type (nth 1 entry)) ; Must be bound for 8850 (class (nth 2 entry)) ; idlwave-routine-twin-compare 8851 (cnt 0) 8852 source type type-cons file alist syslibp key) 8853 (while (setq entry (pop entries)) 8854 (incf cnt) 8855 (setq source (nth 3 entry) 8856 type (car source) 8857 type-cons (cons type (nth 3 source)) 8858 file (idlwave-routine-source-file source)) 8859 8860 ;; Make KEY to index entry properly 8861 (setq key (cond ((eq type 'system) type) 8862 (file (file-truename file)) 8863 (t 'unresolved))) 8864 8865 ;; Check for an entry in the system library 8866 (if (and file 8867 (not syslibp) 8868 (idlwave-syslib-p file)) 8869 (setq syslibp t)) 8870 8871 ;; If there's more than one matching entry for the same file, just 8872 ;; append the type-cons to the type list. 8873 (if (setq entry (assoc key alist)) 8874 (push type-cons (nth 2 entry)) 8875 (push (list key file (list type-cons)) alist))) 8876 8877 (setq alist (nreverse alist)) 8878 8879 (when syslibp 8880 ;; File is in system *library* - remove any 'system entry 8881 (setq alist (delq (assq 'system alist) alist))) 8882 8883 ;; If 'system remains and we've scanned the syslib, it's a builtin 8884 ;; (rather than a !DIR/lib/.pro file bundled as source). 8885 (when (and (idlwave-syslib-scanned-p) 8886 (setq entry (assoc 'system alist))) 8887 (setcar entry 'builtin)) 8888 (sort alist 'idlwave-routine-twin-compare))) 8889 8890(defvar type) 8891(defvar class) 8892(defvar idlwave-sort-prefer-buffer-info t 8893 "Internal variable used to influence `idlwave-routine-twin-compare'.") 8894 8895(defmacro idlwave-xor (a b) 8896 `(and (or ,a ,b) 8897 (not (and ,a ,b)))) 8898 8899(defun idlwave-routine-entry-compare (a b) 8900 "Compare two routine info entries for sortiung. This is the general case. 8901It first compates class, names, and type. If it turns out that A and B 8902are twins (same name, class, and type), calls another routine which 8903compares twins on the basis of their file names and path locations." 8904 (let ((name (car a)) (type (nth 1 a)) (class (nth 2 a))) 8905 (cond 8906 ((not (equal (idlwave-downcase-safe class) 8907 (idlwave-downcase-safe (nth 2 b)))) 8908 ;; Class decides 8909 (cond ((null (nth 2 b)) nil) 8910 ((null class) t) 8911 (t (string< (downcase class) (downcase (nth 2 b)))))) 8912 ((not (equal (downcase name) (downcase (car b)))) 8913 ;; Name decides 8914 (string< (downcase name) (downcase (car b)))) 8915 ((not (eq type (nth 1 b))) 8916 ;; Type decides 8917 (< (if (eq type 'fun) 1 0) (if (eq (nth 1 b) 'fun) 1 0))) 8918 (t 8919 ;; A and B are twins - so the decision is more complicated. 8920 ;; Call twin-compare with the proper arguments. 8921 (idlwave-routine-entry-compare-twins a b))))) 8922 8923(defun idlwave-routine-entry-compare-twins (a b) 8924 "Compare two routine entries, under the assumption that they are 8925twins. This basically calls `idlwave-routine-twin-compare' with the 8926correct args." 8927 (let* ((name (car a)) (type (nth 1 a)) (class (nth 2 a)) ; needed outside 8928 (asrc (nth 3 a)) 8929 (atype (car asrc)) 8930 (bsrc (nth 3 b)) 8931 (btype (car bsrc)) 8932 (afile (idlwave-routine-source-file asrc)) 8933 (bfile (idlwave-routine-source-file bsrc))) 8934 (idlwave-routine-twin-compare 8935 (if (stringp afile) 8936 (list (file-truename afile) afile (list atype)) 8937 (list atype afile (list atype))) 8938 (if (stringp bfile) 8939 (list (file-truename bfile) bfile (list btype)) 8940 (list btype bfile (list btype)))) 8941 )) 8942 8943(defun idlwave-routine-twin-compare (a b) 8944 "Compare two routine twin entries for sorting. 8945In here, A and B are not normal routine info entries, but special 8946lists (KEY FILENAME (TYPES...)). 8947This expects NAME TYPE CLASS to be bound to the right values." 8948 (let* (;; Dis-assemble entries 8949 (akey (car a)) (bkey (car b)) 8950 (afile (nth 1 a)) (bfile (nth 1 b)) 8951 (atypes (nth 2 a)) (btypes (nth 2 b)) 8952 ;; System routines? 8953 (asysp (memq akey '(builtin system))) 8954 (bsysp (memq bkey '(builtin system))) 8955 ;; Compiled routines? 8956 (acompp (memq 'compiled atypes)) 8957 (bcompp (memq 'compiled btypes)) 8958 ;; Unresolved? 8959 (aunresp (or (eq akey 'unresolved) 8960 (and acompp (not afile)))) 8961 (bunresp (or (eq bkey 'unresolved) 8962 (and bcompp (not bfile)))) 8963 ;; Buffer info available? 8964 (abufp (memq 'buffer atypes)) 8965 (bbufp (memq 'buffer btypes)) 8966 ;; On search path? 8967 (tpath-alist (idlwave-true-path-alist)) 8968 (apathp (and (stringp akey) 8969 (assoc (file-name-directory akey) tpath-alist))) 8970 (bpathp (and (stringp bkey) 8971 (assoc (file-name-directory bkey) tpath-alist))) 8972 ;; How early on search path? High number means early since we 8973 ;; measure the tail of the path list 8974 (anpath (length (memq apathp tpath-alist))) 8975 (bnpath (length (memq bpathp tpath-alist))) 8976 ;; Look at file names 8977 (aname (if (stringp afile) (downcase (file-name-nondirectory afile)) "")) 8978 (bname (if (stringp bfile) (downcase (file-name-nondirectory bfile)) "")) 8979 (fname-re (if class (format "\\`%s__\\(%s\\|define\\)\\.pro\\'" 8980 (regexp-quote (downcase class)) 8981 (regexp-quote (downcase name))) 8982 (format "\\`%s\\.pro" (regexp-quote (downcase name))))) 8983 ;; Is file name derived from the routine name? 8984 ;; Method file or class definition file? 8985 (anamep (string-match fname-re aname)) 8986 (adefp (and class anamep (string= "define" (match-string 1 aname)))) 8987 (bnamep (string-match fname-re bname)) 8988 (bdefp (and class bnamep (string= "define" (match-string 1 bname))))) 8989 8990 ;; Now: follow JD's ideas about sorting. Looks really simple now, 8991 ;; doesn't it? The difficult stuff is hidden above... 8992 (cond 8993 ((idlwave-xor asysp bsysp) asysp) ; System entries first 8994 ((idlwave-xor aunresp bunresp) bunresp) ; Unresolved last 8995 ((and idlwave-sort-prefer-buffer-info 8996 (idlwave-xor abufp bbufp)) abufp) ; Buffers before non-buffers 8997 ((idlwave-xor acompp bcompp) acompp) ; Compiled entries 8998 ((idlwave-xor apathp bpathp) apathp) ; Library before non-library 8999 ((idlwave-xor anamep bnamep) anamep) ; Correct file names first 9000 ((and class anamep bnamep ; both file names match -> 9001 (idlwave-xor adefp bdefp)) bdefp) ; __define after __method 9002 ((> anpath bnpath) t) ; Who is first on path? 9003 (t nil)))) ; Default 9004 9005(defun idlwave-routine-source-file (source) 9006 (if (nth 2 source) 9007 (expand-file-name (nth 1 source) (nth 2 source)) 9008 (nth 1 source))) 9009 9010(defun idlwave-downcase-safe (string) 9011 "Donwcase if string, else return unchanged." 9012 (if (stringp string) 9013 (downcase string) 9014 string)) 9015 9016(defun idlwave-count-eq (elt list) 9017 "How often is ELT in LIST?" 9018 (length (delq nil (mapcar (lambda (x) (eq x elt)) list)))) 9019 9020(defun idlwave-count-memq (elt alist) 9021 "How often is ELT a key in ALIST?" 9022 (length (delq nil (mapcar (lambda (x) (eq (car x) elt)) alist)))) 9023 9024(defun idlwave-syslib-p (file) 9025 "Non-nil if FILE is in the system library." 9026 (let* ((true-syslib (file-name-as-directory 9027 (file-truename 9028 (expand-file-name "lib" (idlwave-sys-dir))))) 9029 (true-file (file-truename file))) 9030 (string-match (concat "^" (regexp-quote true-syslib)) true-file))) 9031 9032(defun idlwave-lib-p (file) 9033 "Non-nil if file is in the library" 9034 (let ((true-dir (file-name-directory (file-truename file)))) 9035 (assoc true-dir (idlwave-true-path-alist)))) 9036 9037(defun idlwave-path-alist-add-flag (list-entry flag) 9038 "Add a flag to the path list entry, if not set." 9039 (let ((flags (cdr list-entry))) 9040 (add-to-list 'flags flag) 9041 (setcdr list-entry flags))) 9042 9043(defun idlwave-path-alist-remove-flag (list-entry flag) 9044 "Remove a flag to the path list entry, if set." 9045 (let ((flags (delq flag (cdr list-entry)))) 9046 (setcdr list-entry flags))) 9047 9048(defun idlwave-true-path-alist () 9049 "Return `idlwave-path-alist' alist with true-names. 9050Info is cached, but relies on the functions setting `idlwave-path-alist' 9051to reset the variable `idlwave-true-path-alist' to nil." 9052 (or idlwave-true-path-alist 9053 (setq idlwave-true-path-alist 9054 (mapcar (lambda(x) (cons 9055 (file-name-as-directory 9056 (file-truename 9057 (directory-file-name 9058 (car x)))) 9059 (cdr x))) 9060 idlwave-path-alist)))) 9061 9062(defun idlwave-syslib-scanned-p () 9063 "Non-nil if the system lib file !DIR/lib has been scanned." 9064 (let* ((true-syslib (file-name-as-directory 9065 (file-truename 9066 (expand-file-name "lib" (idlwave-sys-dir)))))) 9067 (cdr (assoc true-syslib (idlwave-true-path-alist))))) 9068 9069;; ---------------------------------------------------------------------------- 9070;; 9071;; Online Help display 9072 9073 9074;; ---------------------------------------------------------------------------- 9075;; 9076;; Additions for use with imenu.el and func-menu.el 9077;; (pop-up a list of IDL units in the current file). 9078;; 9079 9080(defun idlwave-prev-index-position () 9081 "Search for the previous procedure or function. 9082Return nil if not found. For use with imenu.el." 9083 (save-match-data 9084 (cond 9085 ((idlwave-find-key "\\<\\(pro\\|function\\)\\>" -1 'nomark)) 9086 ;; ((idlwave-find-key idlwave-begin-unit-reg 1 'nomark) 9087 (t nil)))) 9088 9089(defun idlwave-unit-name () 9090 "Return the unit name. 9091Assumes that point is at the beginning of the unit as found by 9092`idlwave-prev-index-position'." 9093 (forward-sexp 2) 9094 (forward-sexp -1) 9095 (let ((begin (point))) 9096 (re-search-forward 9097 "[a-zA-Z_][a-zA-Z0-9$_]+\\(::[a-zA-Z_][a-zA-Z0-9$_]+\\)?") 9098 (if (fboundp 'buffer-substring-no-properties) 9099 (buffer-substring-no-properties begin (point)) 9100 (buffer-substring begin (point))))) 9101 9102(defalias 'idlwave-function-menu 9103 (condition-case nil 9104 (progn 9105 (require 'func-menu) 9106 'function-menu) 9107 (error (condition-case nil 9108 (progn 9109 (require 'imenu) 9110 'imenu) 9111 (error nil))))) 9112 9113;; Here we hack func-menu.el in order to support this new mode. 9114;; The latest versions of func-menu.el already have this stuff in, so 9115;; we hack only if it is not already there. 9116(when (fboundp 'eval-after-load) 9117 (eval-after-load "func-menu" 9118 '(progn 9119 (or (assq 'idlwave-mode fume-function-name-regexp-alist) 9120 (not (boundp 'fume-function-name-regexp-idl)) ; avoid problems 9121 (setq fume-function-name-regexp-alist 9122 (cons '(idlwave-mode . fume-function-name-regexp-idl) 9123 fume-function-name-regexp-alist))) 9124 (or (assq 'idlwave-mode fume-find-function-name-method-alist) 9125 (not (fboundp 'fume-find-next-idl-function-name)) ; avoid problems 9126 (setq fume-find-function-name-method-alist 9127 (cons '(idlwave-mode . fume-find-next-idl-function-name) 9128 fume-find-function-name-method-alist)))))) 9129 9130(defun idlwave-edit-in-idlde () 9131 "Edit the current file in IDL Development environment." 9132 (interactive) 9133 (start-process "idldeclient" nil 9134 idlwave-shell-explicit-file-name "-c" "-e" 9135 (buffer-file-name))) 9136 9137(defvar idlwave-help-use-assistant) 9138(defun idlwave-launch-idlhelp () 9139 "Start the IDLhelp application." 9140 (interactive) 9141 (if idlwave-help-use-assistant 9142 (idlwave-help-assistant-raise) 9143 (start-process "idlhelp" nil idlwave-help-application))) 9144 9145;; Menus - using easymenu.el 9146(defvar idlwave-mode-menu-def 9147 `("IDLWAVE" 9148 ["PRO/FUNC menu" idlwave-function-menu t] 9149 ("Motion" 9150 ["Subprogram Start" idlwave-beginning-of-subprogram t] 9151 ["Subprogram End" idlwave-end-of-subprogram t] 9152 ["Block Start" idlwave-beginning-of-block t] 9153 ["Block End" idlwave-end-of-block t] 9154 ["Up Block" idlwave-backward-up-block t] 9155 ["Down Block" idlwave-down-block t] 9156 ["Skip Block Backward" idlwave-backward-block t] 9157 ["Skip Block Forward" idlwave-forward-block t]) 9158 ("Mark" 9159 ["Subprogram" idlwave-mark-subprogram t] 9160 ["Block" idlwave-mark-block t] 9161 ["Header" idlwave-mark-doclib t]) 9162 ("Format" 9163 ["Indent Entire Statement" idlwave-indent-statement 9164 :active t :keys "C-u \\[indent-for-tab-command]" ] 9165 ["Indent Subprogram" idlwave-indent-subprogram t] 9166 ["(Un)Comment Region" idlwave-toggle-comment-region t] 9167 ["Continue/Split line" idlwave-split-line t] 9168 "--" 9169 ["Toggle Auto Fill" idlwave-auto-fill-mode :style toggle 9170 :selected (symbol-value idlwave-fill-function)]) 9171 ("Templates" 9172 ["Procedure" idlwave-procedure t] 9173 ["Function" idlwave-function t] 9174 ["Doc Header" idlwave-doc-header t] 9175 ["Log" idlwave-doc-modification t] 9176 "--" 9177 ["Case" idlwave-case t] 9178 ["For" idlwave-for t] 9179 ["Repeat" idlwave-repeat t] 9180 ["While" idlwave-while t] 9181 "--" 9182 ["Close Block" idlwave-close-block t]) 9183 ("Completion" 9184 ["Complete" idlwave-complete t] 9185 ("Complete Specific" 9186 ["1 Procedure Name" (idlwave-complete 'procedure) t] 9187 ["2 Procedure Keyword" (idlwave-complete 'procedure-keyword) t] 9188 "--" 9189 ["3 Function Name" (idlwave-complete 'function) t] 9190 ["4 Function Keyword" (idlwave-complete 'function-keyword) t] 9191 "--" 9192 ["5 Procedure Method Name" (idlwave-complete 'procedure-method) t] 9193 ["6 Procedure Method Keyword" (idlwave-complete 'procedure-method-keyword) t] 9194 "--" 9195 ["7 Function Method Name" (idlwave-complete 'function-method) t] 9196 ["8 Function Method Keyword" (idlwave-complete 'function-method-keyword) t] 9197 "--" 9198 ["9 Class Name" idlwave-complete-class t])) 9199 ("Routine Info" 9200 ["Show Routine Info" idlwave-routine-info t] 9201 ["Online Context Help" idlwave-context-help t] 9202 "--" 9203 ["Find Routine Source" idlwave-find-module t] 9204 ["Resolve Routine" idlwave-resolve (featurep 'idlw-shell)] 9205 "--" 9206 ["Update Routine Info" idlwave-update-routine-info t] 9207 ["Rescan XML Help Catalog" idlwave-convert-xml-system-routine-info t] 9208 "--" 9209 "IDL User Catalog" 9210 ["Select Catalog Directories" (idlwave-create-user-catalog-file nil) t] 9211 ["Scan Directories" (idlwave-update-routine-info '(16)) 9212 (and idlwave-path-alist (not idlwave-catalog-process))] 9213 ["Scan Directories &" (idlwave-update-routine-info '(64)) 9214 (and idlwave-path-alist (not idlwave-catalog-process))] 9215 "--" 9216 "Routine Shadows" 9217 ["Check Current Buffer" idlwave-list-buffer-load-path-shadows t] 9218 ["Check Compiled Routines" idlwave-list-shell-load-path-shadows t] 9219 ["Check Everything" idlwave-list-all-load-path-shadows t]) 9220 ("Misc" 9221 ["Kill auto-created buffers" idlwave-kill-autoloaded-buffers t] 9222 "--" 9223 ["Insert TAB character" idlwave-hard-tab t]) 9224 "--" 9225 ("External" 9226 ["Start IDL shell" idlwave-shell t] 9227 ["Edit file in IDLDE" idlwave-edit-in-idlde t] 9228 ["Launch IDL Help" idlwave-launch-idlhelp t]) 9229 "--" 9230 ("Customize" 9231 ["Browse IDLWAVE Group" idlwave-customize t] 9232 "--" 9233 ["Build Full Customize Menu" idlwave-create-customize-menu 9234 (fboundp 'customize-menu-create)]) 9235 ("Documentation" 9236 ["Describe Mode" describe-mode t] 9237 ["Abbreviation List" idlwave-list-abbrevs t] 9238 "--" 9239 ["Commentary in idlwave.el" idlwave-show-commentary t] 9240 ["Commentary in idlw-shell.el" idlwave-shell-show-commentary t] 9241 "--" 9242 ["Info" idlwave-info t] 9243 "--" 9244 ["Help with Topic" idlwave-help-assistant-help-with-topic 9245 idlwave-help-use-assistant] 9246 ["Launch IDL Help" idlwave-launch-idlhelp t]))) 9247 9248(defvar idlwave-mode-debug-menu-def 9249 '("Debug" 9250 ["Start IDL shell" idlwave-shell t] 9251 ["Save and .RUN buffer" idlwave-shell-save-and-run 9252 (and (boundp 'idlwave-shell-automatic-start) 9253 idlwave-shell-automatic-start)])) 9254 9255(if (or (featurep 'easymenu) (load "easymenu" t)) 9256 (progn 9257 (easy-menu-define idlwave-mode-menu idlwave-mode-map 9258 "IDL and WAVE CL editing menu" 9259 idlwave-mode-menu-def) 9260 (easy-menu-define idlwave-mode-debug-menu idlwave-mode-map 9261 "IDL and WAVE CL editing menu" 9262 idlwave-mode-debug-menu-def))) 9263 9264(defun idlwave-customize () 9265 "Call the customize function with idlwave as argument." 9266 (interactive) 9267 ;; Try to load the code for the shell, so that we can customize it 9268 ;; as well. 9269 (or (featurep 'idlw-shell) 9270 (load "idlw-shell" t)) 9271 (customize-browse 'idlwave)) 9272 9273(defun idlwave-create-customize-menu () 9274 "Create a full customization menu for IDLWAVE, insert it into the menu." 9275 (interactive) 9276 (if (fboundp 'customize-menu-create) 9277 (progn 9278 ;; Try to load the code for the shell, so that we can customize it 9279 ;; as well. 9280 (or (featurep 'idlw-shell) 9281 (load "idlw-shell" t)) 9282 (easy-menu-change 9283 '("IDLWAVE") "Customize" 9284 `(["Browse IDLWAVE group" idlwave-customize t] 9285 "--" 9286 ,(customize-menu-create 'idlwave) 9287 ["Set" Custom-set t] 9288 ["Save" Custom-save t] 9289 ["Reset to Current" Custom-reset-current t] 9290 ["Reset to Saved" Custom-reset-saved t] 9291 ["Reset to Standard Settings" Custom-reset-standard t])) 9292 (message "\"IDLWAVE\"-menu now contains full customization menu")) 9293 (error "Cannot expand menu (outdated version of cus-edit.el)"))) 9294 9295(defun idlwave-show-commentary () 9296 "Use the finder to view the file documentation from `idlwave.el'." 9297 (interactive) 9298 (require 'finder) 9299 (finder-commentary "idlwave.el")) 9300 9301(defun idlwave-shell-show-commentary () 9302 "Use the finder to view the file documentation from `idlw-shell.el'." 9303 (interactive) 9304 (require 'finder) 9305 (finder-commentary "idlw-shell.el")) 9306 9307(defun idlwave-info () 9308 "Read documentation for IDLWAVE in the info system." 9309 (interactive) 9310 (require 'info) 9311 (Info-goto-node "(idlwave)")) 9312 9313(defun idlwave-list-abbrevs (arg) 9314 "Show the code abbreviations define in IDLWAVE mode. 9315This lists all abbrevs where the replacement text differs from the input text. 9316These are the ones the users want to learn to speed up their writing. 9317 9318The function does *not* list abbrevs which replace a word with itself 9319to call a hook. These hooks are used to change the case of words or 9320to blink the matching `begin', and the user does not need to know them. 9321 9322With arg, list all abbrevs with the corresponding hook. 9323 9324This function was written since `list-abbrevs' looks terrible for IDLWAVE mode." 9325 9326 (interactive "P") 9327 (let ((table (symbol-value 'idlwave-mode-abbrev-table)) 9328 abbrevs 9329 str rpl func fmt (len-str 0) (len-rpl 0)) 9330 (mapatoms 9331 (lambda (sym) 9332 (if (symbol-value sym) 9333 (progn 9334 (setq str (symbol-name sym) 9335 rpl (symbol-value sym) 9336 func (symbol-function sym)) 9337 (if arg 9338 (setq func (prin1-to-string func)) 9339 (if (and (listp func) (stringp (nth 2 func))) 9340 (setq rpl (concat "EVAL: " (nth 2 func)) 9341 func "") 9342 (setq func ""))) 9343 (if (or arg (not (string= rpl str))) 9344 (progn 9345 (setq len-str (max len-str (length str))) 9346 (setq len-rpl (max len-rpl (length rpl))) 9347 (setq abbrevs (cons (list str rpl func) abbrevs))))))) 9348 table) 9349 ;; sort the list 9350 (setq abbrevs (sort abbrevs (lambda (a b) (string< (car a) (car b))))) 9351 ;; Make the format 9352 (setq fmt (format "%%-%ds %%-%ds %%s\n" len-str len-rpl)) 9353 (with-output-to-temp-buffer "*Help*" 9354 (if arg 9355 (progn 9356 (princ "Abbreviations and Actions in IDLWAVE-Mode\n") 9357 (princ "=========================================\n\n") 9358 (princ (format fmt "KEY" "REPLACE" "HOOK")) 9359 (princ (format fmt "---" "-------" "----"))) 9360 (princ "Code Abbreviations and Templates in IDLWAVE-Mode\n") 9361 (princ "================================================\n\n") 9362 (princ (format fmt "KEY" "ACTION" "")) 9363 (princ (format fmt "---" "------" ""))) 9364 (mapcar 9365 (lambda (list) 9366 (setq str (car list) 9367 rpl (nth 1 list) 9368 func (nth 2 list)) 9369 (princ (format fmt str rpl func))) 9370 abbrevs))) 9371 ;; Make sure each abbreviation uses only one display line 9372 (save-excursion 9373 (set-buffer "*Help*") 9374 (setq truncate-lines t))) 9375 9376;; Add .pro files to speedbar for support, if it's loaded 9377(eval-after-load "speedbar" '(speedbar-add-supported-extension ".pro")) 9378 9379;; Set an idle timer to load the routine info. 9380;; Will only work on systems which support this. 9381(or idlwave-routines (idlwave-start-load-rinfo-timer)) 9382 9383;;;###autoload (add-to-list 'auto-mode-alist '("\\.[Pp][Rr][Oo]\\'" . idlwave-mode)) 9384 9385;; Run the hook 9386(run-hooks 'idlwave-load-hook) 9387 9388(provide 'idlwave) 9389 9390;; arch-tag: f77f3b0c-c37c-424f-a328-0886fd42b6fb 9391;;; idlwave.el ends here 9392