diff options
| author | Karoly Lorentey | 2006-10-14 17:36:28 +0000 |
|---|---|---|
| committer | Karoly Lorentey | 2006-10-14 17:36:28 +0000 |
| commit | 12b6af5c7ed2cfdb9783312bf890cf1e6c80c67a (patch) | |
| tree | 1775f9fd1c92defd8b61304a08ec00da95bc4539 /lisp/progmodes | |
| parent | 3f87f67ee215ffeecbd2f53bd7f342cdf03f47df (diff) | |
| parent | f763da8d0808af7c80d72bc586bf4fcf50b37ddd (diff) | |
| download | emacs-12b6af5c7ed2cfdb9783312bf890cf1e6c80c67a.tar.gz emacs-12b6af5c7ed2cfdb9783312bf890cf1e6c80c67a.zip | |
Merged from emacs@sv.gnu.org
Patches applied:
* emacs@sv.gnu.org/emacs--devo--0--patch-413
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-414
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-415
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-416
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-417
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-418
Merge from gnus--rel--5.10
* emacs@sv.gnu.org/emacs--devo--0--patch-419
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-420
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-421
Merge from gnus--rel--5.10
* emacs@sv.gnu.org/emacs--devo--0--patch-422
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-423
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-424
Merge from gnus--rel--5.10
* emacs@sv.gnu.org/emacs--devo--0--patch-425
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-426
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-427
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-428
Merge from gnus--rel--5.10
* emacs@sv.gnu.org/emacs--devo--0--patch-429
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-430
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-431
Merge from gnus--rel--5.10
* emacs@sv.gnu.org/emacs--devo--0--patch-432
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-433
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-434
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-435
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-436
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-437
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-438
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-439
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-440
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-441
lisp/url/url-methods.el: Fix format error when http_proxy is empty string
* emacs@sv.gnu.org/emacs--devo--0--patch-442
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-443
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-444
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-445
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-446
Merge from gnus--rel--5.10
* emacs@sv.gnu.org/emacs--devo--0--patch-447
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-448
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-449
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-450
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-451
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-452
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-453
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-454
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-455
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-456
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-457
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-458
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-459
Merge from gnus--rel--5.10
* emacs@sv.gnu.org/emacs--devo--0--patch-460
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-461
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-462
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-463
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-464
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-465
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-466
Merge from gnus--rel--5.10
* emacs@sv.gnu.org/emacs--devo--0--patch-467
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-468
Merge from gnus--rel--5.10
* emacs@sv.gnu.org/emacs--devo--0--patch-469
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-470
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-471
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-472
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-473
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-128
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-129
Merge from emacs--devo--0
* emacs@sv.gnu.org/gnus--rel--5.10--patch-130
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-131
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-132
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-133
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-134
Merge from emacs--devo--0
* emacs@sv.gnu.org/gnus--rel--5.10--patch-135
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-136
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-137
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-138
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-139
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-140
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-141
Merge from emacs--devo--0
* emacs@sv.gnu.org/gnus--rel--5.10--patch-142
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-143
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-144
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-145
Merge from emacs--devo--0
* emacs@sv.gnu.org/gnus--rel--5.10--patch-146
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-147
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-148
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-149
Update from CVS
git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-582
Diffstat (limited to 'lisp/progmodes')
| -rw-r--r-- | lisp/progmodes/cfengine.el | 14 | ||||
| -rw-r--r-- | lisp/progmodes/compile.el | 45 | ||||
| -rw-r--r-- | lisp/progmodes/cperl-mode.el | 4130 | ||||
| -rw-r--r-- | lisp/progmodes/ebnf2ps.el | 225 | ||||
| -rw-r--r-- | lisp/progmodes/gdb-ui.el | 42 | ||||
| -rw-r--r-- | lisp/progmodes/gud.el | 4 | ||||
| -rw-r--r-- | lisp/progmodes/idlwave.el | 942 | ||||
| -rw-r--r-- | lisp/progmodes/make-mode.el | 4 | ||||
| -rw-r--r-- | lisp/progmodes/prolog.el | 164 | ||||
| -rw-r--r-- | lisp/progmodes/python.el | 118 | ||||
| -rw-r--r-- | lisp/progmodes/sh-script.el | 81 |
11 files changed, 3857 insertions, 1912 deletions
diff --git a/lisp/progmodes/cfengine.el b/lisp/progmodes/cfengine.el index 1b62774a72d..b70fe58b543 100644 --- a/lisp/progmodes/cfengine.el +++ b/lisp/progmodes/cfengine.el | |||
| @@ -85,6 +85,12 @@ This includes those for cfservd as well as cfagent.")) | |||
| 85 | ;; File, acl &c in group: { token ... } | 85 | ;; File, acl &c in group: { token ... } |
| 86 | ("{[ \t]*\\([^ \t\n]+\\)" 1 font-lock-constant-face))) | 86 | ("{[ \t]*\\([^ \t\n]+\\)" 1 font-lock-constant-face))) |
| 87 | 87 | ||
| 88 | (defconst cfengine-font-lock-syntactic-keywords | ||
| 89 | ;; In the main syntax-table, backslash is marked as a punctuation, because | ||
| 90 | ;; of its use in DOS-style directory separators. Here we try to recognize | ||
| 91 | ;; the cases where backslash is used as an escape inside strings. | ||
| 92 | '(("\\(\\(?:\\\\\\)+\\)\"" . "\\"))) | ||
| 93 | |||
| 88 | (defvar cfengine-imenu-expression | 94 | (defvar cfengine-imenu-expression |
| 89 | `((nil ,(concat "^[ \t]*" (eval-when-compile | 95 | `((nil ,(concat "^[ \t]*" (eval-when-compile |
| 90 | (regexp-opt cfengine-actions t)) | 96 | (regexp-opt cfengine-actions t)) |
| @@ -218,7 +224,7 @@ to the action header." | |||
| 218 | ;; variable substitution: | 224 | ;; variable substitution: |
| 219 | (modify-syntax-entry ?$ "." cfengine-mode-syntax-table) | 225 | (modify-syntax-entry ?$ "." cfengine-mode-syntax-table) |
| 220 | ;; Doze path separators: | 226 | ;; Doze path separators: |
| 221 | (modify-syntax-entry ?\\ "_" cfengine-mode-syntax-table) | 227 | (modify-syntax-entry ?\\ "." cfengine-mode-syntax-table) |
| 222 | ;; Otherwise, syntax defaults seem OK to give reasonable word | 228 | ;; Otherwise, syntax defaults seem OK to give reasonable word |
| 223 | ;; movement. | 229 | ;; movement. |
| 224 | 230 | ||
| @@ -237,7 +243,9 @@ to the action header." | |||
| 237 | ;; functions in evaluated classes to string syntax, and then obey | 243 | ;; functions in evaluated classes to string syntax, and then obey |
| 238 | ;; syntax properties. | 244 | ;; syntax properties. |
| 239 | (setq font-lock-defaults | 245 | (setq font-lock-defaults |
| 240 | '(cfengine-font-lock-keywords nil nil nil beginning-of-line)) | 246 | '(cfengine-font-lock-keywords nil nil nil beginning-of-line |
| 247 | (font-lock-syntactic-keywords | ||
| 248 | . cfengine-font-lock-syntactic-keywords))) | ||
| 241 | (setq imenu-generic-expression cfengine-imenu-expression) | 249 | (setq imenu-generic-expression cfengine-imenu-expression) |
| 242 | (set (make-local-variable 'beginning-of-defun-function) | 250 | (set (make-local-variable 'beginning-of-defun-function) |
| 243 | #'cfengine-beginning-of-defun) | 251 | #'cfengine-beginning-of-defun) |
| @@ -249,5 +257,5 @@ to the action header." | |||
| 249 | 257 | ||
| 250 | (provide 'cfengine) | 258 | (provide 'cfengine) |
| 251 | 259 | ||
| 252 | ;;; arch-tag: 6b931be2-1505-4124-afa6-9675971e26d4 | 260 | ;; arch-tag: 6b931be2-1505-4124-afa6-9675971e26d4 |
| 253 | ;;; cfengine.el ends here | 261 | ;;; cfengine.el ends here |
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index e8c09113d39..7d9ce41229c 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el | |||
| @@ -218,10 +218,6 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1)) | |||
| 218 | nil 1 nil 2 0 | 218 | nil 1 nil 2 0 |
| 219 | (2 (compilation-face '(3)))) | 219 | (2 (compilation-face '(3)))) |
| 220 | 220 | ||
| 221 | (gcc-include | ||
| 222 | "^\\(?:In file included\\| \\) from \ | ||
| 223 | \\(.+\\):\\([0-9]+\\)\\(?:\\(:\\)\\|\\(,\\)\\)?" 1 2 nil (3 . 4)) | ||
| 224 | |||
| 225 | (gnu | 221 | (gnu |
| 226 | ;; I have no idea what this first line is supposed to match, but it | 222 | ;; I have no idea what this first line is supposed to match, but it |
| 227 | ;; makes things ambiguous with output such as "foo:344:50:blabla" since | 223 | ;; makes things ambiguous with output such as "foo:344:50:blabla" since |
| @@ -233,7 +229,7 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1)) | |||
| 233 | ;; the last line tries to rule out message where the info after the | 229 | ;; the last line tries to rule out message where the info after the |
| 234 | ;; line number starts with "SS". --Stef | 230 | ;; line number starts with "SS". --Stef |
| 235 | "^\\(?:[[:alpha:]][-[:alnum:].]+: ?\\)?\ | 231 | "^\\(?:[[:alpha:]][-[:alnum:].]+: ?\\)?\ |
| 236 | \\([0-9]*[^0-9\n].*?\\): ?\ | 232 | \\([0-9]*[^0-9\n]\\(?:[^\n ]\\| [^-\n]\\)*?\\): ?\ |
| 237 | \\([0-9]+\\)\\(?:\\([.:]\\)\\([0-9]+\\)\\)?\ | 233 | \\([0-9]+\\)\\(?:\\([.:]\\)\\([0-9]+\\)\\)?\ |
| 238 | \\(?:-\\([0-9]+\\)?\\(?:\\3\\([0-9]+\\)\\)?\\)?:\ | 234 | \\(?:-\\([0-9]+\\)?\\(?:\\3\\([0-9]+\\)\\)?\\)?:\ |
| 239 | \\(?: *\\(\\(?:Future\\|Runtime\\)?[Ww]arning\\|W:\\)\\|\ | 235 | \\(?: *\\(\\(?:Future\\|Runtime\\)?[Ww]arning\\|W:\\)\\|\ |
| @@ -241,6 +237,12 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1)) | |||
| 241 | \[0-9]?\\(?:[^0-9\n]\\|$\\)\\|[0-9][0-9][0-9]\\)" | 237 | \[0-9]?\\(?:[^0-9\n]\\|$\\)\\|[0-9][0-9][0-9]\\)" |
| 242 | 1 (2 . 5) (4 . 6) (7 . 8)) | 238 | 1 (2 . 5) (4 . 6) (7 . 8)) |
| 243 | 239 | ||
| 240 | ;; The `gnu' style above can incorrectly match gcc's "In file | ||
| 241 | ;; included from" message, so we process that first. -- cyd | ||
| 242 | (gcc-include | ||
| 243 | "^\\(?:In file included\\| \\) from \ | ||
| 244 | \\(.+\\):\\([0-9]+\\)\\(?:\\(:\\)\\|\\(,\\)\\)?" 1 2 nil (3 . 4)) | ||
| 245 | |||
| 244 | (lcc | 246 | (lcc |
| 245 | "^\\(?:E\\|\\(W\\)\\), \\([^(\n]+\\)(\\([0-9]+\\),[ \t]*\\([0-9]+\\)" | 247 | "^\\(?:E\\|\\(W\\)\\), \\([^(\n]+\\)(\\([0-9]+\\),[ \t]*\\([0-9]+\\)" |
| 246 | 2 3 4 (1)) | 248 | 2 3 4 (1)) |
| @@ -623,7 +625,7 @@ Faces `compilation-error-face', `compilation-warning-face', | |||
| 623 | (cons (match-string-no-properties idx) dir)) | 625 | (cons (match-string-no-properties idx) dir)) |
| 624 | mouse-face highlight | 626 | mouse-face highlight |
| 625 | keymap compilation-button-map | 627 | keymap compilation-button-map |
| 626 | help-echo "mouse-2: visit current directory"))) | 628 | help-echo "mouse-2: visit this directory"))) |
| 627 | 629 | ||
| 628 | ;; Data type `reverse-ordered-alist' retriever. This function retrieves the | 630 | ;; Data type `reverse-ordered-alist' retriever. This function retrieves the |
| 629 | ;; KEY element from the ALIST, creating it in the right position if not already | 631 | ;; KEY element from the ALIST, creating it in the right position if not already |
| @@ -1066,7 +1068,8 @@ Returns the compilation buffer created." | |||
| 1066 | (window-width)))) | 1068 | (window-width)))) |
| 1067 | ;; Set the EMACS variable, but | 1069 | ;; Set the EMACS variable, but |
| 1068 | ;; don't override users' setting of $EMACS. | 1070 | ;; don't override users' setting of $EMACS. |
| 1069 | (unless (getenv "EMACS") '("EMACS=t")) | 1071 | (unless (getenv "EMACS") |
| 1072 | (list (concat "EMACS=" invocation-directory invocation-name))) | ||
| 1070 | (copy-sequence process-environment)))) | 1073 | (copy-sequence process-environment)))) |
| 1071 | (set (make-local-variable 'compilation-arguments) | 1074 | (set (make-local-variable 'compilation-arguments) |
| 1072 | (list command mode name-function highlight-regexp)) | 1075 | (list command mode name-function highlight-regexp)) |
| @@ -1781,17 +1784,31 @@ and overlay is highlighted between MK and END-MK." | |||
| 1781 | (current-buffer))) | 1784 | (current-buffer))) |
| 1782 | (move-overlay compilation-highlight-overlay | 1785 | (move-overlay compilation-highlight-overlay |
| 1783 | (point) end (current-buffer))) | 1786 | (point) end (current-buffer))) |
| 1784 | (if (numberp next-error-highlight) | 1787 | (if (or (eq next-error-highlight t) |
| 1785 | (setq next-error-highlight-timer | 1788 | (numberp next-error-highlight)) |
| 1786 | (run-at-time next-error-highlight nil 'delete-overlay | 1789 | ;; We want highlighting: delete overlay on next input. |
| 1787 | compilation-highlight-overlay))) | 1790 | (add-hook 'pre-command-hook |
| 1788 | (if (not (or (eq next-error-highlight t) | 1791 | 'compilation-goto-locus-delete-o) |
| 1789 | (numberp next-error-highlight))) | 1792 | ;; We don't want highlighting: delete overlay now. |
| 1790 | (delete-overlay compilation-highlight-overlay)))))) | 1793 | (delete-overlay compilation-highlight-overlay)) |
| 1794 | ;; We want highlighting for a limited time: | ||
| 1795 | ;; set up a timer to delete it. | ||
| 1796 | (when (numberp next-error-highlight) | ||
| 1797 | (setq next-error-highlight-timer | ||
| 1798 | (run-at-time next-error-highlight nil | ||
| 1799 | 'compilation-goto-locus-delete-o))))))) | ||
| 1791 | (when (and (eq next-error-highlight 'fringe-arrow)) | 1800 | (when (and (eq next-error-highlight 'fringe-arrow)) |
| 1801 | ;; We want a fringe arrow (instead of highlighting). | ||
| 1792 | (setq next-error-overlay-arrow-position | 1802 | (setq next-error-overlay-arrow-position |
| 1793 | (copy-marker (line-beginning-position)))))) | 1803 | (copy-marker (line-beginning-position)))))) |
| 1794 | 1804 | ||
| 1805 | (defun compilation-goto-locus-delete-o () | ||
| 1806 | (delete-overlay compilation-highlight-overlay) | ||
| 1807 | ;; Get rid of timer and hook that would try to do this again. | ||
| 1808 | (if (timerp next-error-highlight-timer) | ||
| 1809 | (cancel-timer next-error-highlight-timer)) | ||
| 1810 | (remove-hook 'pre-command-hook | ||
| 1811 | 'compilation-goto-locus-delete-o)) | ||
| 1795 | 1812 | ||
| 1796 | (defun compilation-find-file (marker filename directory &rest formats) | 1813 | (defun compilation-find-file (marker filename directory &rest formats) |
| 1797 | "Find a buffer for file FILENAME. | 1814 | "Find a buffer for file FILENAME. |
diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index ad44753f352..3264e0e72f6 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el | |||
| @@ -5,7 +5,7 @@ | |||
| 5 | ;; Free Software Foundation, Inc. | 5 | ;; Free Software Foundation, Inc. |
| 6 | 6 | ||
| 7 | ;; Author: Ilya Zakharevich and Bob Olson | 7 | ;; Author: Ilya Zakharevich and Bob Olson |
| 8 | ;; Maintainer: Ilya Zakharevich <cperl@ilyaz.org> | 8 | ;; Maintainer: Ilya Zakharevich <ilyaz@cpan.org> |
| 9 | ;; Keywords: languages, Perl | 9 | ;; Keywords: languages, Perl |
| 10 | 10 | ||
| 11 | ;; This file is part of GNU Emacs. | 11 | ;; This file is part of GNU Emacs. |
| @@ -25,7 +25,7 @@ | |||
| 25 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, | 25 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
| 26 | ;; Boston, MA 02110-1301, USA. | 26 | ;; Boston, MA 02110-1301, USA. |
| 27 | 27 | ||
| 28 | ;;; Corrections made by Ilya Zakharevich cperl@ilyaz.org | 28 | ;;; Corrections made by Ilya Zakharevich ilyaz@cpan.org |
| 29 | 29 | ||
| 30 | ;;; Commentary: | 30 | ;;; Commentary: |
| 31 | 31 | ||
| @@ -67,67 +67,89 @@ | |||
| 67 | ;; likewise with m, tr, y, q, qX instead of s | 67 | ;; likewise with m, tr, y, q, qX instead of s |
| 68 | 68 | ||
| 69 | ;;; Code: | 69 | ;;; Code: |
| 70 | 70 | ||
| 71 | (defvar vc-rcs-header) | 71 | (defvar vc-rcs-header) |
| 72 | (defvar vc-sccs-header) | 72 | (defvar vc-sccs-header) |
| 73 | 73 | ||
| 74 | ;; Some macros are needed for `defcustom' | ||
| 75 | (eval-when-compile | 74 | (eval-when-compile |
| 76 | (condition-case nil | 75 | (condition-case nil |
| 77 | (require 'man) | 76 | (require 'custom) |
| 78 | (error nil)) | 77 | (error nil)) |
| 79 | (defconst cperl-xemacs-p (string-match "XEmacs\\|Lucid" emacs-version)) | 78 | (condition-case nil |
| 80 | (defvar cperl-can-font-lock | 79 | (require 'man) |
| 81 | (or cperl-xemacs-p | 80 | (error nil)) |
| 82 | (and (boundp 'emacs-major-version) | 81 | (defconst cperl-xemacs-p (string-match "XEmacs\\|Lucid" emacs-version)) |
| 83 | (or window-system | 82 | (defvar cperl-can-font-lock |
| 84 | (> emacs-major-version 20))))) | 83 | (or cperl-xemacs-p |
| 85 | (if cperl-can-font-lock | 84 | (and (boundp 'emacs-major-version) |
| 86 | (require 'font-lock)) | 85 | (or window-system |
| 87 | (defvar msb-menu-cond) | 86 | (> emacs-major-version 20))))) |
| 88 | (defvar gud-perldb-history) | 87 | (if cperl-can-font-lock |
| 89 | (defvar font-lock-background-mode) ; not in Emacs | 88 | (require 'font-lock)) |
| 90 | (defvar font-lock-display-type) ; ditto | 89 | (defvar msb-menu-cond) |
| 91 | (defmacro cperl-is-face (arg) ; Takes quoted arg | 90 | (defvar gud-perldb-history) |
| 92 | (cond ((fboundp 'find-face) | 91 | (defvar font-lock-background-mode) ; not in Emacs |
| 93 | `(find-face ,arg)) | 92 | (defvar font-lock-display-type) ; ditto |
| 94 | (;;(and (fboundp 'face-list) | 93 | (defvar paren-backwards-message) ; Not in newer XEmacs? |
| 95 | ;; (face-list)) | 94 | (or (fboundp 'defgroup) |
| 96 | (fboundp 'face-list) | 95 | (defmacro defgroup (name val doc &rest arr) |
| 97 | `(member ,arg (and (fboundp 'face-list) | 96 | nil)) |
| 98 | (face-list)))) | 97 | (or (fboundp 'custom-declare-variable) |
| 99 | (t | 98 | (defmacro defcustom (name val doc &rest arr) |
| 100 | `(boundp ,arg)))) | 99 | (` (defvar (, name) (, val) (, doc))))) |
| 101 | (defmacro cperl-make-face (arg descr) ; Takes unquoted arg | 100 | (or (and (fboundp 'custom-declare-variable) |
| 102 | (cond ((fboundp 'make-face) | 101 | (string< "19.31" emacs-version)) ; Checked with 19.30: defface does not work |
| 103 | `(make-face (quote ,arg))) | 102 | (defmacro defface (&rest arr) |
| 104 | (t | 103 | nil)) |
| 105 | `(defvar ,arg (quote ,arg) ,descr)))) | 104 | ;; Avoid warning (tmp definitions) |
| 106 | (defmacro cperl-force-face (arg descr) ; Takes unquoted arg | 105 | (or (fboundp 'x-color-defined-p) |
| 107 | `(progn | 106 | (defmacro x-color-defined-p (col) |
| 108 | (or (cperl-is-face (quote ,arg)) | 107 | (cond ((fboundp 'color-defined-p) (` (color-defined-p (, col)))) |
| 109 | (cperl-make-face ,arg ,descr)) | 108 | ;; XEmacs >= 19.12 |
| 110 | (or (boundp (quote ,arg)) ; We use unquoted variants too | 109 | ((fboundp 'valid-color-name-p) (` (valid-color-name-p (, col)))) |
| 111 | (defvar ,arg (quote ,arg) ,descr)))) | 110 | ;; XEmacs 19.11 |
| 112 | (if cperl-xemacs-p | 111 | ((fboundp 'x-valid-color-name-p) (` (x-valid-color-name-p (, col)))) |
| 113 | (defmacro cperl-etags-snarf-tag (file line) | 112 | (t '(error "Cannot implement color-defined-p"))))) |
| 114 | `(progn | 113 | (defmacro cperl-is-face (arg) ; Takes quoted arg |
| 115 | (beginning-of-line 2) | 114 | (cond ((fboundp 'find-face) |
| 116 | (list ,file ,line))) | 115 | (` (find-face (, arg)))) |
| 117 | (defmacro cperl-etags-snarf-tag (file line) | 116 | (;;(and (fboundp 'face-list) |
| 118 | `(etags-snarf-tag))) | 117 | ;; (face-list)) |
| 119 | (if cperl-xemacs-p | 118 | (fboundp 'face-list) |
| 120 | (defmacro cperl-etags-goto-tag-location (elt) | 119 | (` (member (, arg) (and (fboundp 'face-list) |
| 121 | ;;(progn | 120 | (face-list))))) |
| 122 | ;; (switch-to-buffer (get-file-buffer (elt (, elt) 0))) | 121 | (t |
| 123 | ;; (set-buffer (get-file-buffer (elt (, elt) 0))) | 122 | (` (boundp (, arg)))))) |
| 124 | ;; Probably will not work due to some save-excursion??? | 123 | (defmacro cperl-make-face (arg descr) ; Takes unquoted arg |
| 125 | ;; Or save-file-position? | 124 | (cond ((fboundp 'make-face) |
| 126 | ;; (message "Did I get to line %s?" (elt (, elt) 1)) | 125 | (` (make-face (quote (, arg))))) |
| 127 | `(goto-line (string-to-number (elt ,elt 1)))) | 126 | (t |
| 128 | ;;) | 127 | (` (defvar (, arg) (quote (, arg)) (, descr)))))) |
| 129 | (defmacro cperl-etags-goto-tag-location (elt) | 128 | (defmacro cperl-force-face (arg descr) ; Takes unquoted arg |
| 130 | `(etags-goto-tag-location ,elt)))) | 129 | (` (progn |
| 130 | (or (cperl-is-face (quote (, arg))) | ||
| 131 | (cperl-make-face (, arg) (, descr))) | ||
| 132 | (or (boundp (quote (, arg))) ; We use unquoted variants too | ||
| 133 | (defvar (, arg) (quote (, arg)) (, descr)))))) | ||
| 134 | (if cperl-xemacs-p | ||
| 135 | (defmacro cperl-etags-snarf-tag (file line) | ||
| 136 | (` (progn | ||
| 137 | (beginning-of-line 2) | ||
| 138 | (list (, file) (, line))))) | ||
| 139 | (defmacro cperl-etags-snarf-tag (file line) | ||
| 140 | (` (etags-snarf-tag)))) | ||
| 141 | (if cperl-xemacs-p | ||
| 142 | (defmacro cperl-etags-goto-tag-location (elt) | ||
| 143 | (`;;(progn | ||
| 144 | ;; (switch-to-buffer (get-file-buffer (elt (, elt) 0))) | ||
| 145 | ;; (set-buffer (get-file-buffer (elt (, elt) 0))) | ||
| 146 | ;; Probably will not work due to some save-excursion??? | ||
| 147 | ;; Or save-file-position? | ||
| 148 | ;; (message "Did I get to line %s?" (elt (, elt) 1)) | ||
| 149 | (goto-line (string-to-int (elt (, elt) 1))))) | ||
| 150 | ;;) | ||
| 151 | (defmacro cperl-etags-goto-tag-location (elt) | ||
| 152 | (` (etags-goto-tag-location (, elt)))))) | ||
| 131 | 153 | ||
| 132 | (defconst cperl-xemacs-p (string-match "XEmacs\\|Lucid" emacs-version)) | 154 | (defconst cperl-xemacs-p (string-match "XEmacs\\|Lucid" emacs-version)) |
| 133 | 155 | ||
| @@ -251,6 +273,12 @@ This is in addition to cperl-continued-statement-offset." | |||
| 251 | :type 'integer | 273 | :type 'integer |
| 252 | :group 'cperl-indentation-details) | 274 | :group 'cperl-indentation-details) |
| 253 | 275 | ||
| 276 | (defcustom cperl-indent-wrt-brace t | ||
| 277 | "*Non-nil means indent statements in if/etc block relative brace, not if/etc. | ||
| 278 | Versions 5.2 ... 5.20 behaved as if this were `nil'." | ||
| 279 | :type 'boolean | ||
| 280 | :group 'cperl-indentation-details) | ||
| 281 | |||
| 254 | (defcustom cperl-auto-newline nil | 282 | (defcustom cperl-auto-newline nil |
| 255 | "*Non-nil means automatically newline before and after braces, | 283 | "*Non-nil means automatically newline before and after braces, |
| 256 | and after colons and semicolons, inserted in CPerl code. The following | 284 | and after colons and semicolons, inserted in CPerl code. The following |
| @@ -347,20 +375,26 @@ Affects: `cperl-font-lock', `cperl-electric-lbrace-space', | |||
| 347 | :type 'integer | 375 | :type 'integer |
| 348 | :group 'cperl-indentation-details) | 376 | :group 'cperl-indentation-details) |
| 349 | 377 | ||
| 350 | (defvar cperl-vc-header-alist nil) | 378 | (defcustom cperl-indent-comment-at-column-0 nil |
| 351 | (make-obsolete-variable | 379 | "*Non-nil means that comment started at column 0 should be indentable." |
| 352 | 'cperl-vc-header-alist | 380 | :type 'boolean |
| 353 | "use cperl-vc-rcs-header or cperl-vc-sccs-header instead.") | 381 | :group 'cperl-indentation-details) |
| 354 | 382 | ||
| 355 | (defcustom cperl-vc-sccs-header '("($sccs) = ('%W\%' =~ /(\\d+(\\.\\d+)+)/) ;") | 383 | (defcustom cperl-vc-sccs-header '("($sccs) = ('%W\%' =~ /(\\d+(\\.\\d+)+)/) ;") |
| 356 | "*Special version of `vc-sccs-header' that is used in CPerl mode buffers." | 384 | "*Special version of `vc-sccs-header' that is used in CPerl mode buffers." |
| 357 | :type '(repeat string) | 385 | :type '(repeat string) |
| 358 | :group 'cperl) | 386 | :group 'cperl) |
| 359 | 387 | ||
| 360 | (defcustom cperl-vc-rcs-header '("($rcs) = (' $Id\$ ' =~ /(\\d+(\\.\\d+)+)/) ;") | 388 | (defcustom cperl-vc-rcs-header '("($rcs) = (' $Id\$ ' =~ /(\\d+(\\.\\d+)+)/);") |
| 361 | "*Special version of `vc-rcs-header' that is used in CPerl mode buffers." | 389 | "*Special version of `vc-rcs-header' that is used in CPerl mode buffers." |
| 362 | :type '(repeat string) | 390 | :type '(repeat string) |
| 363 | :group 'cperl) | 391 | :group 'cperl) |
| 392 | |||
| 393 | ;; This became obsolete... | ||
| 394 | (defvar cperl-vc-header-alist nil) | ||
| 395 | (make-obsolete-variable | ||
| 396 | 'cperl-vc-header-alist | ||
| 397 | "use cperl-vc-rcs-header or cperl-vc-sccs-header instead.") | ||
| 364 | 398 | ||
| 365 | (defcustom cperl-clobber-mode-lists | 399 | (defcustom cperl-clobber-mode-lists |
| 366 | (not | 400 | (not |
| @@ -408,8 +442,15 @@ Font for POD headers." | |||
| 408 | :type 'face | 442 | :type 'face |
| 409 | :group 'cperl-faces) | 443 | :group 'cperl-faces) |
| 410 | 444 | ||
| 411 | (defcustom cperl-invalid-face 'underline | 445 | ;;; Some double-evaluation happened with font-locks... Needed with 21.2... |
| 412 | "*Face for highlighting trailing whitespace." | 446 | (defvar cperl-singly-quote-face cperl-xemacs-p) |
| 447 | |||
| 448 | (defcustom cperl-invalid-face ; Does not customize with '' on XEmacs | ||
| 449 | (if cperl-singly-quote-face | ||
| 450 | 'underline ''underline) ; On older Emacsen was evaluated by `font-lock' | ||
| 451 | (if cperl-singly-quote-face | ||
| 452 | "*This face is used for highlighting trailing whitespace." | ||
| 453 | "*Face for highlighting trailing whitespace.") | ||
| 413 | :type 'face | 454 | :type 'face |
| 414 | :version "21.1" | 455 | :version "21.1" |
| 415 | :group 'cperl-faces) | 456 | :group 'cperl-faces) |
| @@ -441,7 +482,14 @@ You can always make lookup from menu or using \\[cperl-find-pods-heres]." | |||
| 441 | 482 | ||
| 442 | (defcustom cperl-regexp-scan t | 483 | (defcustom cperl-regexp-scan t |
| 443 | "*Not-nil means make marking of regular expression more thorough. | 484 | "*Not-nil means make marking of regular expression more thorough. |
| 444 | Effective only with `cperl-pod-here-scan'. Not implemented yet." | 485 | Effective only with `cperl-pod-here-scan'." |
| 486 | :type 'boolean | ||
| 487 | :group 'cperl-speed) | ||
| 488 | |||
| 489 | (defcustom cperl-hook-after-change t | ||
| 490 | "*Not-nil means install hook to know which regions of buffer are changed. | ||
| 491 | May significantly speed up delayed fontification. Changes take effect | ||
| 492 | after reload." | ||
| 445 | :type 'boolean | 493 | :type 'boolean |
| 446 | :group 'cperl-speed) | 494 | :group 'cperl-speed) |
| 447 | 495 | ||
| @@ -564,17 +612,25 @@ when syntaxifying a chunk of buffer." | |||
| 564 | :type 'boolean | 612 | :type 'boolean |
| 565 | :group 'cperl-speed) | 613 | :group 'cperl-speed) |
| 566 | 614 | ||
| 615 | (defcustom cperl-syntaxify-for-menu | ||
| 616 | t | ||
| 617 | "*Non-nil means that CPerl syntaxifies up to the point before showing menu. | ||
| 618 | This way enabling/disabling of menu items is more correct." | ||
| 619 | :type 'boolean | ||
| 620 | :group 'cperl-speed) | ||
| 621 | |||
| 567 | (defcustom cperl-ps-print-face-properties | 622 | (defcustom cperl-ps-print-face-properties |
| 568 | '((font-lock-keyword-face nil nil bold shadow) | 623 | '((font-lock-keyword-face nil nil bold shadow) |
| 569 | (font-lock-variable-name-face nil nil bold) | 624 | (font-lock-variable-name-face nil nil bold) |
| 570 | (font-lock-function-name-face nil nil bold italic box) | 625 | (font-lock-function-name-face nil nil bold italic box) |
| 571 | (font-lock-constant-face nil "LightGray" bold) | 626 | (font-lock-constant-face nil "LightGray" bold) |
| 572 | (cperl-array nil "LightGray" bold underline) | 627 | (cperl-array-face nil "LightGray" bold underline) |
| 573 | (cperl-hash nil "LightGray" bold italic underline) | 628 | (cperl-hash-face nil "LightGray" bold italic underline) |
| 574 | (font-lock-comment-face nil "LightGray" italic) | 629 | (font-lock-comment-face nil "LightGray" italic) |
| 575 | (font-lock-string-face nil nil italic underline) | 630 | (font-lock-string-face nil nil italic underline) |
| 576 | (cperl-nonoverridable nil nil italic underline) | 631 | (cperl-nonoverridable-face nil nil italic underline) |
| 577 | (font-lock-type-face nil nil underline) | 632 | (font-lock-type-face nil nil underline) |
| 633 | (font-lock-warning-face nil "LightGray" bold italic box) | ||
| 578 | (underline nil "LightGray" strikeout)) | 634 | (underline nil "LightGray" strikeout)) |
| 579 | "List given as an argument to `ps-extend-face-list' in `cperl-ps-print'." | 635 | "List given as an argument to `ps-extend-face-list' in `cperl-ps-print'." |
| 580 | :type '(repeat (cons symbol | 636 | :type '(repeat (cons symbol |
| @@ -588,7 +644,7 @@ when syntaxifying a chunk of buffer." | |||
| 588 | (defvar cperl-dark-foreground | 644 | (defvar cperl-dark-foreground |
| 589 | (cperl-choose-color "orchid1" "orange")) | 645 | (cperl-choose-color "orchid1" "orange")) |
| 590 | 646 | ||
| 591 | (defface cperl-nonoverridable | 647 | (defface cperl-nonoverridable-face |
| 592 | `((((class grayscale) (background light)) | 648 | `((((class grayscale) (background light)) |
| 593 | (:background "Gray90" :slant italic :underline t)) | 649 | (:background "Gray90" :slant italic :underline t)) |
| 594 | (((class grayscale) (background dark)) | 650 | (((class grayscale) (background dark)) |
| @@ -600,10 +656,8 @@ when syntaxifying a chunk of buffer." | |||
| 600 | (t (:weight bold :underline t))) | 656 | (t (:weight bold :underline t))) |
| 601 | "Font Lock mode face used non-overridable keywords and modifiers of regexps." | 657 | "Font Lock mode face used non-overridable keywords and modifiers of regexps." |
| 602 | :group 'cperl-faces) | 658 | :group 'cperl-faces) |
| 603 | ;; backward-compatibility alias | ||
| 604 | (put 'cperl-nonoverridable-face 'face-alias 'cperl-nonoverridable) | ||
| 605 | 659 | ||
| 606 | (defface cperl-array | 660 | (defface cperl-array-face |
| 607 | `((((class grayscale) (background light)) | 661 | `((((class grayscale) (background light)) |
| 608 | (:background "Gray90" :weight bold)) | 662 | (:background "Gray90" :weight bold)) |
| 609 | (((class grayscale) (background dark)) | 663 | (((class grayscale) (background dark)) |
| @@ -615,10 +669,8 @@ when syntaxifying a chunk of buffer." | |||
| 615 | (t (:weight bold))) | 669 | (t (:weight bold))) |
| 616 | "Font Lock mode face used to highlight array names." | 670 | "Font Lock mode face used to highlight array names." |
| 617 | :group 'cperl-faces) | 671 | :group 'cperl-faces) |
| 618 | ;; backward-compatibility alias | ||
| 619 | (put 'cperl-array-face 'face-alias 'cperl-array) | ||
| 620 | 672 | ||
| 621 | (defface cperl-hash | 673 | (defface cperl-hash-face |
| 622 | `((((class grayscale) (background light)) | 674 | `((((class grayscale) (background light)) |
| 623 | (:background "Gray90" :weight bold :slant italic)) | 675 | (:background "Gray90" :weight bold :slant italic)) |
| 624 | (((class grayscale) (background dark)) | 676 | (((class grayscale) (background dark)) |
| @@ -630,8 +682,6 @@ when syntaxifying a chunk of buffer." | |||
| 630 | (t (:weight bold :slant italic))) | 682 | (t (:weight bold :slant italic))) |
| 631 | "Font Lock mode face used to highlight hash names." | 683 | "Font Lock mode face used to highlight hash names." |
| 632 | :group 'cperl-faces) | 684 | :group 'cperl-faces) |
| 633 | ;; backward-compatibility alias | ||
| 634 | (put 'cperl-hash-face 'face-alias 'cperl-hash) | ||
| 635 | 685 | ||
| 636 | 686 | ||
| 637 | 687 | ||
| @@ -639,9 +689,7 @@ when syntaxifying a chunk of buffer." | |||
| 639 | 689 | ||
| 640 | (defvar cperl-tips 'please-ignore-this-line | 690 | (defvar cperl-tips 'please-ignore-this-line |
| 641 | "Get maybe newer version of this package from | 691 | "Get maybe newer version of this package from |
| 642 | ftp://ftp.math.ohio-state.edu/pub/users/ilya/emacs | 692 | http://ilyaz.org/software/emacs |
| 643 | and/or | ||
| 644 | ftp://ftp.math.ohio-state.edu/pub/users/ilya/perl | ||
| 645 | Subdirectory `cperl-mode' may contain yet newer development releases and/or | 693 | Subdirectory `cperl-mode' may contain yet newer development releases and/or |
| 646 | patches to related files. | 694 | patches to related files. |
| 647 | 695 | ||
| @@ -666,9 +714,9 @@ want it to: put the following into your .emacs file: | |||
| 666 | (defalias 'perl-mode 'cperl-mode) | 714 | (defalias 'perl-mode 'cperl-mode) |
| 667 | 715 | ||
| 668 | Get perl5-info from | 716 | Get perl5-info from |
| 669 | $CPAN/doc/manual/info/perl-info.tar.gz | 717 | $CPAN/doc/manual/info/perl5-old/perl5-info.tar.gz |
| 670 | older version was on | 718 | Also, one can generate a newer documentation running `pod2texi' converter |
| 671 | http://www.metronet.com:70/9/perlinfo/perl5/manual/perl5-info.tar.gz | 719 | $CPAN/doc/manual/info/perl5/pod2texi-0.1.tar.gz |
| 672 | 720 | ||
| 673 | If you use imenu-go, run imenu on perl5-info buffer (you can do it | 721 | If you use imenu-go, run imenu on perl5-info buffer (you can do it |
| 674 | from Perl menu). If many files are related, generate TAGS files from | 722 | from Perl menu). If many files are related, generate TAGS files from |
| @@ -700,11 +748,18 @@ micro-docs on what I know about CPerl problems.") | |||
| 700 | "Description of problems in CPerl mode. | 748 | "Description of problems in CPerl mode. |
| 701 | Some faces will not be shown on some versions of Emacs unless you | 749 | Some faces will not be shown on some versions of Emacs unless you |
| 702 | install choose-color.el, available from | 750 | install choose-color.el, available from |
| 703 | ftp://ftp.math.ohio-state.edu/pub/users/ilya/emacs/ | 751 | http://ilyaz.org/software/emacs |
| 704 | 752 | ||
| 705 | `fill-paragraph' on a comment may leave the point behind the | 753 | `fill-paragraph' on a comment may leave the point behind the |
| 706 | paragraph. Parsing of lines with several <<EOF is not implemented | 754 | paragraph. It also triggers a bug in some versions of Emacs (CPerl tries |
| 707 | yet. | 755 | to detect it and bulk out). |
| 756 | |||
| 757 | See documentation of a variable `cperl-problems-old-emaxen' for the | ||
| 758 | problems which disappear if you upgrade Emacs to a reasonably new | ||
| 759 | version (20.3 for Emacs, and those of 2004 for XEmacs).") | ||
| 760 | |||
| 761 | (defvar cperl-problems-old-emaxen 'please-ignore-this-line | ||
| 762 | "Description of problems in CPerl mode specific for older Emacs versions. | ||
| 708 | 763 | ||
| 709 | Emacs had a _very_ restricted syntax parsing engine until version | 764 | Emacs had a _very_ restricted syntax parsing engine until version |
| 710 | 20.1. Most problems below are corrected starting from this version of | 765 | 20.1. Most problems below are corrected starting from this version of |
| @@ -812,6 +867,13 @@ voice); | |||
| 812 | o) Highlights trailing whitespace; | 867 | o) Highlights trailing whitespace; |
| 813 | p) Is able to manipulate Perl Regular Expressions to ease | 868 | p) Is able to manipulate Perl Regular Expressions to ease |
| 814 | conversion to a more readable form. | 869 | conversion to a more readable form. |
| 870 | q) Can ispell POD sections and HERE-DOCs. | ||
| 871 | r) Understands comments and character classes inside regular | ||
| 872 | expressions; can find matching () and [] in a regular expression. | ||
| 873 | s) Allows indentation of //x-style regular expressions; | ||
| 874 | t) Highlights different symbols in regular expressions according | ||
| 875 | to their function; much less problems with backslashitis; | ||
| 876 | u) Allows to find regular expressions which contain interpolated parts. | ||
| 815 | 877 | ||
| 816 | 5) The indentation engine was very smart, but most of tricks may be | 878 | 5) The indentation engine was very smart, but most of tricks may be |
| 817 | not needed anymore with the support for `syntax-table' property. Has | 879 | not needed anymore with the support for `syntax-table' property. Has |
| @@ -829,7 +891,10 @@ the settings present before the switch. | |||
| 829 | line-breaks/spacing between elements of the construct. | 891 | line-breaks/spacing between elements of the construct. |
| 830 | 892 | ||
| 831 | 10) Uses a linear-time algorith for indentation of regions (on Emaxen with | 893 | 10) Uses a linear-time algorith for indentation of regions (on Emaxen with |
| 832 | capable syntax engines).") | 894 | capable syntax engines). |
| 895 | |||
| 896 | 11) Syntax-highlight, indentation, sexp-recognition inside regular expressions. | ||
| 897 | ") | ||
| 833 | 898 | ||
| 834 | (defvar cperl-speed 'please-ignore-this-line | 899 | (defvar cperl-speed 'please-ignore-this-line |
| 835 | "This is an incomplete compendium of what is available in other parts | 900 | "This is an incomplete compendium of what is available in other parts |
| @@ -878,19 +943,19 @@ B) Speed of editing operations. | |||
| 878 | (defvar cperl-tips-faces 'please-ignore-this-line | 943 | (defvar cperl-tips-faces 'please-ignore-this-line |
| 879 | "CPerl mode uses following faces for highlighting: | 944 | "CPerl mode uses following faces for highlighting: |
| 880 | 945 | ||
| 881 | `cperl-array' Array names | 946 | `cperl-array-face' Array names |
| 882 | `cperl-hash' Hash names | 947 | `cperl-hash-face' Hash names |
| 883 | `font-lock-comment-face' Comments, PODs and whatever is considered | 948 | `font-lock-comment-face' Comments, PODs and whatever is considered |
| 884 | syntaxically to be not code | 949 | syntaxically to be not code |
| 885 | `font-lock-constant-face' HERE-doc delimiters, labels, delimiters of | 950 | `font-lock-constant-face' HERE-doc delimiters, labels, delimiters of |
| 886 | 2-arg operators s/y/tr/ or of RExen, | 951 | 2-arg operators s/y/tr/ or of RExen, |
| 887 | `font-lock-function-name-face' Special-cased m// and s//foo/, _ as | 952 | `font-lock-warning-face' Special-cased m// and s//foo/, |
| 888 | a target of a file tests, file tests, | 953 | `font-lock-function-name-face' _ as a target of a file tests, file tests, |
| 889 | subroutine names at the moment of definition | 954 | subroutine names at the moment of definition |
| 890 | (except those conflicting with Perl operators), | 955 | (except those conflicting with Perl operators), |
| 891 | package names (when recognized), format names | 956 | package names (when recognized), format names |
| 892 | `font-lock-keyword-face' Control flow switch constructs, declarators | 957 | `font-lock-keyword-face' Control flow switch constructs, declarators |
| 893 | `cperl-nonoverridable' Non-overridable keywords, modifiers of RExen | 958 | `cperl-nonoverridable-face' Non-overridable keywords, modifiers of RExen |
| 894 | `font-lock-string-face' Strings, qw() constructs, RExen, POD sections, | 959 | `font-lock-string-face' Strings, qw() constructs, RExen, POD sections, |
| 895 | literal parts and the terminator of formats | 960 | literal parts and the terminator of formats |
| 896 | and whatever is syntaxically considered | 961 | and whatever is syntaxically considered |
| @@ -908,7 +973,25 @@ m// and s/// which do not do what one would expect them to do. | |||
| 908 | Help with best setup of these faces for printout requested (for each of | 973 | Help with best setup of these faces for printout requested (for each of |
| 909 | the faces: please specify bold, italic, underline, shadow and box.) | 974 | the faces: please specify bold, italic, underline, shadow and box.) |
| 910 | 975 | ||
| 911 | \(Not finished.)") | 976 | In regular expressions (except character classes): |
| 977 | `font-lock-string-face' \"Normal\" stuff and non-0-length constructs | ||
| 978 | `font-lock-constant-face': Delimiters | ||
| 979 | `font-lock-warning-face' Special-cased m// and s//foo/, | ||
| 980 | Mismatched closing delimiters, parens | ||
| 981 | we couldn't match, misplaced quantifiers, | ||
| 982 | unrecognized escape sequences | ||
| 983 | `cperl-nonoverridable-face' Modifiers, as gism in m/REx/gism | ||
| 984 | `font-lock-type-face' POSIX classes inside charclasses, | ||
| 985 | escape sequences with arguments (\x \23 \p \N) | ||
| 986 | and others match-a-char escape sequences | ||
| 987 | `font-lock-keyword-face' Capturing parens, and | | ||
| 988 | `font-lock-function-name-face' Special symbols: $ ^ . [ ] [^ ] (?{ }) (??{ }) | ||
| 989 | `font-lock-builtin-face' \"Remaining\" 0-length constructs, executable | ||
| 990 | parts of a REx, not-capturing parens | ||
| 991 | `font-lock-variable-name-face' Interpolated constructs, embedded code | ||
| 992 | `font-lock-comment-face' Embedded comments | ||
| 993 | |||
| 994 | ") | ||
| 912 | 995 | ||
| 913 | 996 | ||
| 914 | 997 | ||
| @@ -985,6 +1068,25 @@ the faces: please specify bold, italic, underline, shadow and box.) | |||
| 985 | (cperl-hairy (or hairy t)) | 1068 | (cperl-hairy (or hairy t)) |
| 986 | (t (symbol-value symbol)))) | 1069 | (t (symbol-value symbol)))) |
| 987 | 1070 | ||
| 1071 | |||
| 1072 | (defun cperl-make-indent (column &optional minimum keep) | ||
| 1073 | "Makes indent of the current line the requested amount. | ||
| 1074 | Unless KEEP, removes the old indentation. Works around a bug in ancient | ||
| 1075 | versions of Emacs." | ||
| 1076 | (let ((prop (get-text-property (point) 'syntax-type))) | ||
| 1077 | (or keep | ||
| 1078 | (delete-horizontal-space)) | ||
| 1079 | (indent-to column minimum) | ||
| 1080 | ;; In old versions (e.g., 19.33) `indent-to' would not inherit properties | ||
| 1081 | (and prop | ||
| 1082 | (> (current-column) 0) | ||
| 1083 | (save-excursion | ||
| 1084 | (beginning-of-line) | ||
| 1085 | (or (get-text-property (point) 'syntax-type) | ||
| 1086 | (and (looking-at "\\=[ \t]") | ||
| 1087 | (put-text-property (point) (match-end 0) | ||
| 1088 | 'syntax-type prop))))))) | ||
| 1089 | |||
| 988 | ;;; Probably it is too late to set these guys already, but it can help later: | 1090 | ;;; Probably it is too late to set these guys already, but it can help later: |
| 989 | 1091 | ||
| 990 | ;;;(and cperl-clobber-mode-lists | 1092 | ;;;(and cperl-clobber-mode-lists |
| @@ -1035,7 +1137,16 @@ the faces: please specify bold, italic, underline, shadow and box.) | |||
| 1035 | (cperl-define-key "\C-c\C-w" 'cperl-toggle-construct-fix) | 1137 | (cperl-define-key "\C-c\C-w" 'cperl-toggle-construct-fix) |
| 1036 | (cperl-define-key "\C-c\C-f" 'auto-fill-mode) | 1138 | (cperl-define-key "\C-c\C-f" 'auto-fill-mode) |
| 1037 | (cperl-define-key "\C-c\C-e" 'cperl-toggle-electric) | 1139 | (cperl-define-key "\C-c\C-e" 'cperl-toggle-electric) |
| 1140 | (cperl-define-key "\C-c\C-b" 'cperl-find-bad-style) | ||
| 1141 | (cperl-define-key "\C-c\C-p" 'cperl-pod-spell) | ||
| 1142 | (cperl-define-key "\C-c\C-d" 'cperl-here-doc-spell) | ||
| 1143 | (cperl-define-key "\C-c\C-n" 'cperl-narrow-to-here-doc) | ||
| 1144 | (cperl-define-key "\C-c\C-v" 'cperl-next-interpolated-REx) | ||
| 1145 | (cperl-define-key "\C-c\C-x" 'cperl-next-interpolated-REx-0) | ||
| 1146 | (cperl-define-key "\C-c\C-y" 'cperl-next-interpolated-REx-1) | ||
| 1038 | (cperl-define-key "\C-c\C-ha" 'cperl-toggle-autohelp) | 1147 | (cperl-define-key "\C-c\C-ha" 'cperl-toggle-autohelp) |
| 1148 | (cperl-define-key "\C-c\C-hp" 'cperl-perldoc) | ||
| 1149 | (cperl-define-key "\C-c\C-hP" 'cperl-perldoc-at-point) | ||
| 1039 | (cperl-define-key "\e\C-q" 'cperl-indent-exp) ; Usually not bound | 1150 | (cperl-define-key "\e\C-q" 'cperl-indent-exp) ; Usually not bound |
| 1040 | (cperl-define-key [?\C-\M-\|] 'cperl-lineup | 1151 | (cperl-define-key [?\C-\M-\|] 'cperl-lineup |
| 1041 | [(control meta |)]) | 1152 | [(control meta |)]) |
| @@ -1074,9 +1185,13 @@ the faces: please specify bold, italic, underline, shadow and box.) | |||
| 1074 | (<= emacs-minor-version 11) (<= emacs-major-version 19)) | 1185 | (<= emacs-minor-version 11) (<= emacs-major-version 19)) |
| 1075 | (progn | 1186 | (progn |
| 1076 | ;; substitute-key-definition is usefulness-deenhanced... | 1187 | ;; substitute-key-definition is usefulness-deenhanced... |
| 1077 | (cperl-define-key "\M-q" 'cperl-fill-paragraph) | 1188 | ;;;;;(cperl-define-key "\M-q" 'cperl-fill-paragraph) |
| 1078 | (cperl-define-key "\e;" 'cperl-indent-for-comment) | 1189 | (cperl-define-key "\e;" 'cperl-indent-for-comment) |
| 1079 | (cperl-define-key "\e\C-\\" 'cperl-indent-region)) | 1190 | (cperl-define-key "\e\C-\\" 'cperl-indent-region)) |
| 1191 | (or (boundp 'fill-paragraph-function) | ||
| 1192 | (substitute-key-definition | ||
| 1193 | 'fill-paragraph 'cperl-fill-paragraph | ||
| 1194 | cperl-mode-map global-map)) | ||
| 1080 | (substitute-key-definition | 1195 | (substitute-key-definition |
| 1081 | 'indent-sexp 'cperl-indent-exp | 1196 | 'indent-sexp 'cperl-indent-exp |
| 1082 | cperl-mode-map global-map) | 1197 | cperl-mode-map global-map) |
| @@ -1094,52 +1209,101 @@ the faces: please specify bold, italic, underline, shadow and box.) | |||
| 1094 | (progn | 1209 | (progn |
| 1095 | (require 'easymenu) | 1210 | (require 'easymenu) |
| 1096 | (easy-menu-define | 1211 | (easy-menu-define |
| 1097 | cperl-menu cperl-mode-map "Menu for CPerl mode" | 1212 | cperl-menu cperl-mode-map "Menu for CPerl mode" |
| 1098 | '("Perl" | 1213 | '("Perl" |
| 1099 | ["Beginning of function" beginning-of-defun t] | 1214 | ["Beginning of function" beginning-of-defun t] |
| 1100 | ["End of function" end-of-defun t] | 1215 | ["End of function" end-of-defun t] |
| 1101 | ["Mark function" mark-defun t] | 1216 | ["Mark function" mark-defun t] |
| 1102 | ["Indent expression" cperl-indent-exp t] | 1217 | ["Indent expression" cperl-indent-exp t] |
| 1103 | ["Fill paragraph/comment" fill-paragraph t] | 1218 | ["Fill paragraph/comment" fill-paragraph t] |
| 1219 | "----" | ||
| 1220 | ["Line up a construction" cperl-lineup (cperl-use-region-p)] | ||
| 1221 | ["Invert if/unless/while etc" cperl-invert-if-unless t] | ||
| 1222 | ("Regexp" | ||
| 1223 | ["Beautify" cperl-beautify-regexp | ||
| 1224 | cperl-use-syntax-table-text-property] | ||
| 1225 | ["Beautify one level deep" (cperl-beautify-regexp 1) | ||
| 1226 | cperl-use-syntax-table-text-property] | ||
| 1227 | ["Beautify a group" cperl-beautify-level | ||
| 1228 | cperl-use-syntax-table-text-property] | ||
| 1229 | ["Beautify a group one level deep" (cperl-beautify-level 1) | ||
| 1230 | cperl-use-syntax-table-text-property] | ||
| 1231 | ["Contract a group" cperl-contract-level | ||
| 1232 | cperl-use-syntax-table-text-property] | ||
| 1233 | ["Contract groups" cperl-contract-levels | ||
| 1234 | cperl-use-syntax-table-text-property] | ||
| 1104 | "----" | 1235 | "----" |
| 1105 | ["Line up a construction" cperl-lineup (cperl-use-region-p)] | 1236 | ["Find next interpolated" cperl-next-interpolated-REx |
| 1106 | ["Invert if/unless/while etc" cperl-invert-if-unless t] | 1237 | (next-single-property-change (point-min) 'REx-interpolated)] |
| 1107 | ("Regexp" | 1238 | ["Find next interpolated (no //o)" |
| 1108 | ["Beautify" cperl-beautify-regexp | 1239 | cperl-next-interpolated-REx-0 |
| 1109 | cperl-use-syntax-table-text-property] | 1240 | (or (text-property-any (point-min) (point-max) 'REx-interpolated t) |
| 1110 | ["Beautify one level deep" (cperl-beautify-regexp 1) | 1241 | (text-property-any (point-min) (point-max) 'REx-interpolated 1))] |
| 1111 | cperl-use-syntax-table-text-property] | 1242 | ["Find next interpolated (neither //o nor whole-REx)" |
| 1112 | ["Beautify a group" cperl-beautify-level | 1243 | cperl-next-interpolated-REx-1 |
| 1113 | cperl-use-syntax-table-text-property] | 1244 | (text-property-any (point-min) (point-max) 'REx-interpolated t)]) |
| 1114 | ["Beautify a group one level deep" (cperl-beautify-level 1) | 1245 | ["Insert spaces if needed to fix style" cperl-find-bad-style t] |
| 1115 | cperl-use-syntax-table-text-property] | 1246 | ["Refresh \"hard\" constructions" cperl-find-pods-heres t] |
| 1116 | ["Contract a group" cperl-contract-level | 1247 | "----" |
| 1117 | cperl-use-syntax-table-text-property] | 1248 | ["Indent region" cperl-indent-region (cperl-use-region-p)] |
| 1118 | ["Contract groups" cperl-contract-levels | 1249 | ["Comment region" cperl-comment-region (cperl-use-region-p)] |
| 1119 | cperl-use-syntax-table-text-property]) | 1250 | ["Uncomment region" cperl-uncomment-region (cperl-use-region-p)] |
| 1120 | ["Refresh \"hard\" constructions" cperl-find-pods-heres t] | 1251 | "----" |
| 1252 | ["Run" mode-compile (fboundp 'mode-compile)] | ||
| 1253 | ["Kill" mode-compile-kill (and (fboundp 'mode-compile-kill) | ||
| 1254 | (get-buffer "*compilation*"))] | ||
| 1255 | ["Next error" next-error (get-buffer "*compilation*")] | ||
| 1256 | ["Check syntax" cperl-check-syntax (fboundp 'mode-compile)] | ||
| 1257 | "----" | ||
| 1258 | ["Debugger" cperl-db t] | ||
| 1259 | "----" | ||
| 1260 | ("Tools" | ||
| 1261 | ["Imenu" imenu (fboundp 'imenu)] | ||
| 1262 | ["Imenu on Perl Info" cperl-imenu-on-info (featurep 'imenu)] | ||
| 1121 | "----" | 1263 | "----" |
| 1122 | ["Indent region" cperl-indent-region (cperl-use-region-p)] | 1264 | ["Ispell PODs" cperl-pod-spell |
| 1123 | ["Comment region" cperl-comment-region (cperl-use-region-p)] | 1265 | ;; Better not to update syntaxification here: |
| 1124 | ["Uncomment region" cperl-uncomment-region (cperl-use-region-p)] | 1266 | ;; debugging syntaxificatio can be broken by this??? |
| 1267 | (or | ||
| 1268 | (get-text-property (point-min) 'in-pod) | ||
| 1269 | (< (progn | ||
| 1270 | (and cperl-syntaxify-for-menu | ||
| 1271 | (cperl-update-syntaxification (point-max) (point-max))) | ||
| 1272 | (next-single-property-change (point-min) 'in-pod nil (point-max))) | ||
| 1273 | (point-max)))] | ||
| 1274 | ["Ispell HERE-DOCs" cperl-here-doc-spell | ||
| 1275 | (< (progn | ||
| 1276 | (and cperl-syntaxify-for-menu | ||
| 1277 | (cperl-update-syntaxification (point-max) (point-max))) | ||
| 1278 | (next-single-property-change (point-min) 'here-doc-group nil (point-max))) | ||
| 1279 | (point-max))] | ||
| 1280 | ["Narrow to this HERE-DOC" cperl-narrow-to-here-doc | ||
| 1281 | (eq 'here-doc (progn | ||
| 1282 | (and cperl-syntaxify-for-menu | ||
| 1283 | (cperl-update-syntaxification (point) (point))) | ||
| 1284 | (get-text-property (point) 'syntax-type)))] | ||
| 1285 | ["Select this HERE-DOC or POD section" | ||
| 1286 | cperl-select-this-pod-or-here-doc | ||
| 1287 | (memq (progn | ||
| 1288 | (and cperl-syntaxify-for-menu | ||
| 1289 | (cperl-update-syntaxification (point) (point))) | ||
| 1290 | (get-text-property (point) 'syntax-type)) | ||
| 1291 | '(here-doc pod))] | ||
| 1125 | "----" | 1292 | "----" |
| 1126 | ["Run" mode-compile (fboundp 'mode-compile)] | 1293 | ["CPerl pretty print (exprmntl)" cperl-ps-print |
| 1127 | ["Kill" mode-compile-kill (and (fboundp 'mode-compile-kill) | 1294 | (fboundp 'ps-extend-face-list)] |
| 1128 | (get-buffer "*compilation*"))] | ||
| 1129 | ["Next error" next-error (get-buffer "*compilation*")] | ||
| 1130 | ["Check syntax" cperl-check-syntax (fboundp 'mode-compile)] | ||
| 1131 | "----" | 1295 | "----" |
| 1132 | ["Debugger" cperl-db t] | 1296 | ["Syntaxify region" cperl-find-pods-heres-region |
| 1297 | (cperl-use-region-p)] | ||
| 1298 | ["Profile syntaxification" cperl-time-fontification t] | ||
| 1299 | ["Debug errors in delayed fontification" cperl-emulate-lazy-lock t] | ||
| 1300 | ["Debug unwind for syntactic scan" cperl-toggle-set-debug-unwind t] | ||
| 1301 | ["Debug backtrace on syntactic scan (BEWARE!!!)" | ||
| 1302 | (cperl-toggle-set-debug-unwind nil t) t] | ||
| 1133 | "----" | 1303 | "----" |
| 1134 | ("Tools" | 1304 | ["Class Hierarchy from TAGS" cperl-tags-hier-init t] |
| 1135 | ["Imenu" imenu (fboundp 'imenu)] | 1305 | ;;["Update classes" (cperl-tags-hier-init t) tags-table-list] |
| 1136 | ["Insert spaces if needed" cperl-find-bad-style t] | 1306 | ("Tags" |
| 1137 | ["Class Hierarchy from TAGS" cperl-tags-hier-init t] | ||
| 1138 | ;;["Update classes" (cperl-tags-hier-init t) tags-table-list] | ||
| 1139 | ["CPerl pretty print (exprmntl)" cperl-ps-print | ||
| 1140 | (fboundp 'ps-extend-face-list)] | ||
| 1141 | ["Imenu on info" cperl-imenu-on-info (featurep 'imenu)] | ||
| 1142 | ("Tags" | ||
| 1143 | ;;; ["Create tags for current file" cperl-etags t] | 1307 | ;;; ["Create tags for current file" cperl-etags t] |
| 1144 | ;;; ["Add tags for current file" (cperl-etags t) t] | 1308 | ;;; ["Add tags for current file" (cperl-etags t) t] |
| 1145 | ;;; ["Create tags for Perl files in directory" (cperl-etags nil t) t] | 1309 | ;;; ["Create tags for Perl files in directory" (cperl-etags nil t) t] |
| @@ -1186,10 +1350,10 @@ the faces: please specify bold, italic, underline, shadow and box.) | |||
| 1186 | ["PerlStyle" (cperl-set-style "PerlStyle") t] | 1350 | ["PerlStyle" (cperl-set-style "PerlStyle") t] |
| 1187 | ["GNU" (cperl-set-style "GNU") t] | 1351 | ["GNU" (cperl-set-style "GNU") t] |
| 1188 | ["C++" (cperl-set-style "C++") t] | 1352 | ["C++" (cperl-set-style "C++") t] |
| 1189 | ["FSF" (cperl-set-style "FSF") t] | 1353 | ["K&R" (cperl-set-style "K&R") t] |
| 1190 | ["BSD" (cperl-set-style "BSD") t] | 1354 | ["BSD" (cperl-set-style "BSD") t] |
| 1191 | ["Whitesmith" (cperl-set-style "Whitesmith") t] | 1355 | ["Whitesmith" (cperl-set-style "Whitesmith") t] |
| 1192 | ["Current" (cperl-set-style "Current") t] | 1356 | ["Memorize Current" (cperl-set-style "Current") t] |
| 1193 | ["Memorized" (cperl-set-style-back) cperl-old-style]) | 1357 | ["Memorized" (cperl-set-style-back) cperl-old-style]) |
| 1194 | ("Micro-docs" | 1358 | ("Micro-docs" |
| 1195 | ["Tips" (describe-variable 'cperl-tips) t] | 1359 | ["Tips" (describe-variable 'cperl-tips) t] |
| @@ -1208,12 +1372,73 @@ the faces: please specify bold, italic, underline, shadow and box.) | |||
| 1208 | The expansion is entirely correct because it uses the C preprocessor." | 1372 | The expansion is entirely correct because it uses the C preprocessor." |
| 1209 | t) | 1373 | t) |
| 1210 | 1374 | ||
| 1375 | ;;; These two must be unwound, otherwise take exponential time | ||
| 1376 | (defconst cperl-maybe-white-and-comment-rex "[ \t\n]*\\(#[^\n]*\n[ \t\n]*\\)*" | ||
| 1377 | "Regular expression to match optional whitespace with interpspersed comments. | ||
| 1378 | Should contain exactly one group.") | ||
| 1379 | |||
| 1380 | ;;; This one is tricky to unwind; still very inefficient... | ||
| 1381 | (defconst cperl-white-and-comment-rex "\\([ \t\n]\\|#[^\n]*\n\\)+" | ||
| 1382 | "Regular expression to match whitespace with interpspersed comments. | ||
| 1383 | Should contain exactly one group.") | ||
| 1384 | |||
| 1385 | |||
| 1386 | ;;; Is incorporated in `cperl-imenu--function-name-regexp-perl' | ||
| 1387 | ;;; `cperl-outline-regexp', `defun-prompt-regexp'. | ||
| 1388 | ;;; Details of groups in this may be used in several functions; see comments | ||
| 1389 | ;;; near mentioned above variable(s)... | ||
| 1390 | ;;; sub($$):lvalue{} sub:lvalue{} Both allowed... | ||
| 1391 | (defsubst cperl-after-sub-regexp (named attr) ; 9 groups without attr... | ||
| 1392 | "Match the text after `sub' in a subroutine declaration. | ||
| 1393 | If NAMED is nil, allows anonymous subroutines. Matches up to the first \":\" | ||
| 1394 | of attributes (if present), or end of the name or prototype (whatever is | ||
| 1395 | the last)." | ||
| 1396 | (concat ; Assume n groups before this... | ||
| 1397 | "\\(" ; n+1=name-group | ||
| 1398 | cperl-white-and-comment-rex ; n+2=pre-name | ||
| 1399 | "\\(::[a-zA-Z_0-9:']+\\|[a-zA-Z_'][a-zA-Z_0-9:']*\\)" ; n+3=name | ||
| 1400 | "\\)" ; END n+1=name-group | ||
| 1401 | (if named "" "?") | ||
| 1402 | "\\(" ; n+4=proto-group | ||
| 1403 | cperl-maybe-white-and-comment-rex ; n+5=pre-proto | ||
| 1404 | "\\(([^()]*)\\)" ; n+6=prototype | ||
| 1405 | "\\)?" ; END n+4=proto-group | ||
| 1406 | "\\(" ; n+7=attr-group | ||
| 1407 | cperl-maybe-white-and-comment-rex ; n+8=pre-attr | ||
| 1408 | "\\(" ; n+9=start-attr | ||
| 1409 | ":" | ||
| 1410 | (if attr (concat | ||
| 1411 | "\\(" | ||
| 1412 | cperl-maybe-white-and-comment-rex ; whitespace-comments | ||
| 1413 | "\\(\\sw\\|_\\)+" ; attr-name | ||
| 1414 | ;; attr-arg (1 level of internal parens allowed!) | ||
| 1415 | "\\((\\(\\\\.\\|[^\\\\()]\\|([^\\\\()]*)\\)*)\\)?" | ||
| 1416 | "\\(" ; optional : (XXX allows trailing???) | ||
| 1417 | cperl-maybe-white-and-comment-rex ; whitespace-comments | ||
| 1418 | ":\\)?" | ||
| 1419 | "\\)+") | ||
| 1420 | "[^:]") | ||
| 1421 | "\\)" | ||
| 1422 | "\\)?" ; END n+6=proto-group | ||
| 1423 | )) | ||
| 1424 | |||
| 1425 | ;;; Details of groups in this are used in `cperl-imenu--create-perl-index' | ||
| 1426 | ;;; and `cperl-outline-level'. | ||
| 1427 | ;;;; Was: 2=sub|package; now 2=package-group, 5=package-name 8=sub-name (+3) | ||
| 1211 | (defvar cperl-imenu--function-name-regexp-perl | 1428 | (defvar cperl-imenu--function-name-regexp-perl |
| 1212 | (concat | 1429 | (concat |
| 1213 | "^\\(" | 1430 | "^\\(" ; 1 = all |
| 1214 | "[ \t]*\\(sub\\|package\\)[ \t\n]+\\([a-zA-Z_0-9:']+\\)[ \t]*\\(([^()]*)[ \t]*\\)?" | 1431 | "\\([ \t]*package" ; 2 = package-group |
| 1215 | "\\|" | 1432 | "\\(" ; 3 = package-name-group |
| 1216 | "=head\\([12]\\)[ \t]+\\([^\n]+\\)$" | 1433 | cperl-white-and-comment-rex ; 4 = pre-package-name |
| 1434 | "\\([a-zA-Z_0-9:']+\\)\\)?\\)" ; 5 = package-name | ||
| 1435 | "\\|" | ||
| 1436 | "[ \t]*sub" | ||
| 1437 | (cperl-after-sub-regexp 'named nil) ; 8=name 11=proto 14=attr-start | ||
| 1438 | cperl-maybe-white-and-comment-rex ; 15=pre-block | ||
| 1439 | "\\|" | ||
| 1440 | "=head\\([1-4]\\)[ \t]+" ; 16=level | ||
| 1441 | "\\([^\n]+\\)$" ; 17=text | ||
| 1217 | "\\)")) | 1442 | "\\)")) |
| 1218 | 1443 | ||
| 1219 | (defvar cperl-outline-regexp | 1444 | (defvar cperl-outline-regexp |
| @@ -1225,6 +1450,12 @@ The expansion is entirely correct because it uses the C preprocessor." | |||
| 1225 | (defvar cperl-string-syntax-table nil | 1450 | (defvar cperl-string-syntax-table nil |
| 1226 | "Syntax table in use in CPerl mode string-like chunks.") | 1451 | "Syntax table in use in CPerl mode string-like chunks.") |
| 1227 | 1452 | ||
| 1453 | (defsubst cperl-1- (p) | ||
| 1454 | (max (point-min) (1- p))) | ||
| 1455 | |||
| 1456 | (defsubst cperl-1+ (p) | ||
| 1457 | (min (point-max) (1+ p))) | ||
| 1458 | |||
| 1228 | (if cperl-mode-syntax-table | 1459 | (if cperl-mode-syntax-table |
| 1229 | () | 1460 | () |
| 1230 | (setq cperl-mode-syntax-table (make-syntax-table)) | 1461 | (setq cperl-mode-syntax-table (make-syntax-table)) |
| @@ -1249,6 +1480,8 @@ The expansion is entirely correct because it uses the C preprocessor." | |||
| 1249 | (modify-syntax-entry ?| "." cperl-mode-syntax-table) | 1480 | (modify-syntax-entry ?| "." cperl-mode-syntax-table) |
| 1250 | (setq cperl-string-syntax-table (copy-syntax-table cperl-mode-syntax-table)) | 1481 | (setq cperl-string-syntax-table (copy-syntax-table cperl-mode-syntax-table)) |
| 1251 | (modify-syntax-entry ?$ "." cperl-string-syntax-table) | 1482 | (modify-syntax-entry ?$ "." cperl-string-syntax-table) |
| 1483 | (modify-syntax-entry ?\{ "." cperl-string-syntax-table) | ||
| 1484 | (modify-syntax-entry ?\} "." cperl-string-syntax-table) | ||
| 1252 | (modify-syntax-entry ?# "." cperl-string-syntax-table)) ; (?# comment ) | 1485 | (modify-syntax-entry ?# "." cperl-string-syntax-table)) ; (?# comment ) |
| 1253 | 1486 | ||
| 1254 | 1487 | ||
| @@ -1257,6 +1490,10 @@ The expansion is entirely correct because it uses the C preprocessor." | |||
| 1257 | ;; Fix for msb.el | 1490 | ;; Fix for msb.el |
| 1258 | (defvar cperl-msb-fixed nil) | 1491 | (defvar cperl-msb-fixed nil) |
| 1259 | (defvar cperl-use-major-mode 'cperl-mode) | 1492 | (defvar cperl-use-major-mode 'cperl-mode) |
| 1493 | (defvar cperl-font-lock-multiline-start nil) | ||
| 1494 | (defvar cperl-font-lock-multiline nil) | ||
| 1495 | (defvar cperl-compilation-error-regexp-alist nil) | ||
| 1496 | (defvar cperl-font-locking nil) | ||
| 1260 | 1497 | ||
| 1261 | ;;;###autoload | 1498 | ;;;###autoload |
| 1262 | (defun cperl-mode () | 1499 | (defun cperl-mode () |
| @@ -1402,16 +1639,24 @@ Variables controlling indentation style: | |||
| 1402 | `cperl-min-label-indent' | 1639 | `cperl-min-label-indent' |
| 1403 | Minimal indentation for line that is a label. | 1640 | Minimal indentation for line that is a label. |
| 1404 | 1641 | ||
| 1405 | Settings for K&R and BSD indentation styles are | 1642 | Settings for classic indent-styles: K&R BSD=C++ GNU PerlStyle=Whitesmith |
| 1406 | `cperl-indent-level' 5 8 | 1643 | `cperl-indent-level' 5 4 2 4 |
| 1407 | `cperl-continued-statement-offset' 5 8 | 1644 | `cperl-brace-offset' 0 0 0 0 |
| 1408 | `cperl-brace-offset' -5 -8 | 1645 | `cperl-continued-brace-offset' -5 -4 0 0 |
| 1409 | `cperl-label-offset' -5 -8 | 1646 | `cperl-label-offset' -5 -4 -2 -4 |
| 1647 | `cperl-continued-statement-offset' 5 4 2 4 | ||
| 1410 | 1648 | ||
| 1411 | CPerl knows several indentation styles, and may bulk set the | 1649 | CPerl knows several indentation styles, and may bulk set the |
| 1412 | corresponding variables. Use \\[cperl-set-style] to do this. Use | 1650 | corresponding variables. Use \\[cperl-set-style] to do this. Use |
| 1413 | \\[cperl-set-style-back] to restore the memorized preexisting values | 1651 | \\[cperl-set-style-back] to restore the memorized preexisting values |
| 1414 | \(both available from menu). | 1652 | \(both available from menu). See examples in `cperl-style-examples'. |
| 1653 | |||
| 1654 | Part of the indentation style is how different parts of if/elsif/else | ||
| 1655 | statements are broken into lines; in CPerl, this is reflected on how | ||
| 1656 | templates for these constructs are created (controlled by | ||
| 1657 | `cperl-extra-newline-before-brace'), and how reflow-logic should treat \"continuation\" blocks of else/elsif/continue, controlled by the same variable, | ||
| 1658 | and by `cperl-extra-newline-before-brace-multiline', | ||
| 1659 | `cperl-merge-trailing-else', `cperl-indent-region-fix-constructs'. | ||
| 1415 | 1660 | ||
| 1416 | If `cperl-indent-level' is 0, the statement after opening brace in | 1661 | If `cperl-indent-level' is 0, the statement after opening brace in |
| 1417 | column 0 is indented on | 1662 | column 0 is indented on |
| @@ -1465,8 +1710,12 @@ or as help on variables `cperl-tips', `cperl-problems', | |||
| 1465 | ("head2" "head2" cperl-electric-pod 0))) | 1710 | ("head2" "head2" cperl-electric-pod 0))) |
| 1466 | (setq abbrevs-changed prev-a-c))) | 1711 | (setq abbrevs-changed prev-a-c))) |
| 1467 | (setq local-abbrev-table cperl-mode-abbrev-table) | 1712 | (setq local-abbrev-table cperl-mode-abbrev-table) |
| 1468 | (abbrev-mode (if (cperl-val 'cperl-electric-keywords) 1 0)) | 1713 | (if (cperl-val 'cperl-electric-keywords) |
| 1714 | (abbrev-mode 1)) | ||
| 1469 | (set-syntax-table cperl-mode-syntax-table) | 1715 | (set-syntax-table cperl-mode-syntax-table) |
| 1716 | ;; Until Emacs is multi-threaded, we do not actually need it local: | ||
| 1717 | (make-local-variable 'cperl-font-lock-multiline-start) | ||
| 1718 | (make-local-variable 'cperl-font-locking) | ||
| 1470 | (make-local-variable 'outline-regexp) | 1719 | (make-local-variable 'outline-regexp) |
| 1471 | ;; (setq outline-regexp imenu-example--function-name-regexp-perl) | 1720 | ;; (setq outline-regexp imenu-example--function-name-regexp-perl) |
| 1472 | (setq outline-regexp cperl-outline-regexp) | 1721 | (setq outline-regexp cperl-outline-regexp) |
| @@ -1478,7 +1727,10 @@ or as help on variables `cperl-tips', `cperl-problems', | |||
| 1478 | (setq paragraph-separate paragraph-start) | 1727 | (setq paragraph-separate paragraph-start) |
| 1479 | (make-local-variable 'paragraph-ignore-fill-prefix) | 1728 | (make-local-variable 'paragraph-ignore-fill-prefix) |
| 1480 | (setq paragraph-ignore-fill-prefix t) | 1729 | (setq paragraph-ignore-fill-prefix t) |
| 1481 | (set (make-local-variable 'fill-paragraph-function) 'cperl-fill-paragraph) | 1730 | (if cperl-xemacs-p |
| 1731 | (progn | ||
| 1732 | (make-local-variable 'paren-backwards-message) | ||
| 1733 | (set 'paren-backwards-message t))) | ||
| 1482 | (make-local-variable 'indent-line-function) | 1734 | (make-local-variable 'indent-line-function) |
| 1483 | (setq indent-line-function 'cperl-indent-line) | 1735 | (setq indent-line-function 'cperl-indent-line) |
| 1484 | (make-local-variable 'require-final-newline) | 1736 | (make-local-variable 'require-final-newline) |
| @@ -1492,9 +1744,22 @@ or as help on variables `cperl-tips', `cperl-problems', | |||
| 1492 | (make-local-variable 'comment-start-skip) | 1744 | (make-local-variable 'comment-start-skip) |
| 1493 | (setq comment-start-skip "#+ *") | 1745 | (setq comment-start-skip "#+ *") |
| 1494 | (make-local-variable 'defun-prompt-regexp) | 1746 | (make-local-variable 'defun-prompt-regexp) |
| 1495 | (setq defun-prompt-regexp "^[ \t]*sub[ \t\n]+\\([^ \t\n{(;]+\\)\\([ \t\n]*([^()]*)[ \t\n]*\\)?[ \t\n]*") | 1747 | ;;; "[ \t]*sub" |
| 1748 | ;;; (cperl-after-sub-regexp 'named nil) ; 8=name 11=proto 14=attr-start | ||
| 1749 | ;;; cperl-maybe-white-and-comment-rex ; 15=pre-block | ||
| 1750 | (setq defun-prompt-regexp | ||
| 1751 | (concat "^[ \t]*\\(sub" | ||
| 1752 | (cperl-after-sub-regexp 'named 'attr-groups) | ||
| 1753 | "\\|" ; per toke.c | ||
| 1754 | "\\(BEGIN\\|CHECK\\|INIT\\|END\\|AUTOLOAD\\|DESTROY\\)" | ||
| 1755 | "\\)" | ||
| 1756 | cperl-maybe-white-and-comment-rex)) | ||
| 1496 | (make-local-variable 'comment-indent-function) | 1757 | (make-local-variable 'comment-indent-function) |
| 1497 | (setq comment-indent-function 'cperl-comment-indent) | 1758 | (setq comment-indent-function 'cperl-comment-indent) |
| 1759 | (and (boundp 'fill-paragraph-function) | ||
| 1760 | (progn | ||
| 1761 | (make-local-variable 'fill-paragraph-function) | ||
| 1762 | (set 'fill-paragraph-function 'cperl-fill-paragraph))) | ||
| 1498 | (make-local-variable 'parse-sexp-ignore-comments) | 1763 | (make-local-variable 'parse-sexp-ignore-comments) |
| 1499 | (setq parse-sexp-ignore-comments t) | 1764 | (setq parse-sexp-ignore-comments t) |
| 1500 | (make-local-variable 'indent-region-function) | 1765 | (make-local-variable 'indent-region-function) |
| @@ -1509,21 +1774,40 @@ or as help on variables `cperl-tips', `cperl-problems', | |||
| 1509 | (set 'vc-rcs-header cperl-vc-rcs-header) | 1774 | (set 'vc-rcs-header cperl-vc-rcs-header) |
| 1510 | (make-local-variable 'vc-sccs-header) | 1775 | (make-local-variable 'vc-sccs-header) |
| 1511 | (set 'vc-sccs-header cperl-vc-sccs-header) | 1776 | (set 'vc-sccs-header cperl-vc-sccs-header) |
| 1777 | ;; This one is obsolete... | ||
| 1778 | (make-local-variable 'vc-header-alist) | ||
| 1779 | (set 'vc-header-alist (or cperl-vc-header-alist ; Avoid warning | ||
| 1780 | (` ((SCCS (, (car cperl-vc-sccs-header))) | ||
| 1781 | (RCS (, (car cperl-vc-rcs-header))))))) | ||
| 1782 | (cond ((boundp 'compilation-error-regexp-alist-alist);; xemacs 20.x | ||
| 1783 | (make-local-variable 'compilation-error-regexp-alist-alist) | ||
| 1784 | (set 'compilation-error-regexp-alist-alist | ||
| 1785 | (cons (cons 'cperl cperl-compilation-error-regexp-alist) | ||
| 1786 | (symbol-value 'compilation-error-regexp-alist-alist))) | ||
| 1787 | (if (fboundp 'compilation-build-compilation-error-regexp-alist) | ||
| 1788 | (let ((f 'compilation-build-compilation-error-regexp-alist)) | ||
| 1789 | (funcall f)) | ||
| 1790 | (push 'cperl compilation-error-regexp-alist))) | ||
| 1791 | ((boundp 'compilation-error-regexp-alist);; xmeacs 19.x | ||
| 1792 | (make-local-variable 'compilation-error-regexp-alist) | ||
| 1793 | (set 'compilation-error-regexp-alist | ||
| 1794 | (cons cperl-compilation-error-regexp-alist | ||
| 1795 | (symbol-value 'compilation-error-regexp-alist))))) | ||
| 1512 | (make-local-variable 'font-lock-defaults) | 1796 | (make-local-variable 'font-lock-defaults) |
| 1513 | (setq font-lock-defaults | 1797 | (setq font-lock-defaults |
| 1514 | (cond | 1798 | (cond |
| 1515 | ((string< emacs-version "19.30") | 1799 | ((string< emacs-version "19.30") |
| 1516 | '(cperl-font-lock-keywords-2)) | 1800 | '(cperl-font-lock-keywords-2 nil nil ((?_ . "w")))) |
| 1517 | ((string< emacs-version "19.33") ; Which one to use? | 1801 | ((string< emacs-version "19.33") ; Which one to use? |
| 1518 | '((cperl-font-lock-keywords | 1802 | '((cperl-font-lock-keywords |
| 1519 | cperl-font-lock-keywords-1 | 1803 | cperl-font-lock-keywords-1 |
| 1520 | cperl-font-lock-keywords-2))) | 1804 | cperl-font-lock-keywords-2) nil nil ((?_ . "w")))) |
| 1521 | (t | 1805 | (t |
| 1522 | '((cperl-load-font-lock-keywords | 1806 | '((cperl-load-font-lock-keywords |
| 1523 | cperl-load-font-lock-keywords-1 | 1807 | cperl-load-font-lock-keywords-1 |
| 1524 | cperl-load-font-lock-keywords-2) | 1808 | cperl-load-font-lock-keywords-2) nil nil ((?_ . "w")))))) |
| 1525 | nil nil ((?_ . "w")))))) | ||
| 1526 | (make-local-variable 'cperl-syntax-state) | 1809 | (make-local-variable 'cperl-syntax-state) |
| 1810 | (setq cperl-syntax-state nil) ; reset syntaxification cache | ||
| 1527 | (if cperl-use-syntax-table-text-property | 1811 | (if cperl-use-syntax-table-text-property |
| 1528 | (progn | 1812 | (progn |
| 1529 | (make-local-variable 'parse-sexp-lookup-properties) | 1813 | (make-local-variable 'parse-sexp-lookup-properties) |
| @@ -1533,10 +1817,12 @@ or as help on variables `cperl-tips', `cperl-problems', | |||
| 1533 | (or (boundp 'font-lock-unfontify-region-function) | 1817 | (or (boundp 'font-lock-unfontify-region-function) |
| 1534 | (set 'font-lock-unfontify-region-function | 1818 | (set 'font-lock-unfontify-region-function |
| 1535 | 'font-lock-default-unfontify-region)) | 1819 | 'font-lock-default-unfontify-region)) |
| 1536 | (make-local-variable 'font-lock-unfontify-region-function) | 1820 | (unless cperl-xemacs-p ; Our: just a plug for wrong font-lock |
| 1537 | (set 'font-lock-unfontify-region-function ; not present with old Emacs | 1821 | (make-local-variable 'font-lock-unfontify-region-function) |
| 1538 | 'cperl-font-lock-unfontify-region-function) | 1822 | (set 'font-lock-unfontify-region-function ; not present with old Emacs |
| 1823 | 'cperl-font-lock-unfontify-region-function)) | ||
| 1539 | (make-local-variable 'cperl-syntax-done-to) | 1824 | (make-local-variable 'cperl-syntax-done-to) |
| 1825 | (setq cperl-syntax-done-to nil) ; reset syntaxification cache | ||
| 1540 | (make-local-variable 'font-lock-syntactic-keywords) | 1826 | (make-local-variable 'font-lock-syntactic-keywords) |
| 1541 | (setq font-lock-syntactic-keywords | 1827 | (setq font-lock-syntactic-keywords |
| 1542 | (if cperl-syntaxify-by-font-lock | 1828 | (if cperl-syntaxify-by-font-lock |
| @@ -1546,10 +1832,20 @@ or as help on variables `cperl-tips', `cperl-problems', | |||
| 1546 | ;; to make font-lock think that font-lock-syntactic-keywords | 1832 | ;; to make font-lock think that font-lock-syntactic-keywords |
| 1547 | ;; are defined. | 1833 | ;; are defined. |
| 1548 | '(t))))) | 1834 | '(t))))) |
| 1835 | (if (boundp 'font-lock-multiline) ; Newer font-lock; use its facilities | ||
| 1836 | (progn | ||
| 1837 | (setq cperl-font-lock-multiline t) ; Not localized... | ||
| 1838 | (set 'font-lock-multiline t)) ; not present with old Emacs; auto-local | ||
| 1839 | (make-local-variable 'font-lock-fontify-region-function) | ||
| 1840 | (set 'font-lock-fontify-region-function ; not present with old Emacs | ||
| 1841 | 'cperl-font-lock-fontify-region-function)) | ||
| 1842 | (make-local-variable 'font-lock-fontify-region-function) | ||
| 1843 | (set 'font-lock-fontify-region-function ; not present with old Emacs | ||
| 1844 | 'cperl-font-lock-fontify-region-function) | ||
| 1549 | (make-local-variable 'cperl-old-style) | 1845 | (make-local-variable 'cperl-old-style) |
| 1550 | (if (boundp 'normal-auto-fill-function) ; 19.33 and later | 1846 | (if (boundp 'normal-auto-fill-function) ; 19.33 and later |
| 1551 | (set (make-local-variable 'normal-auto-fill-function) | 1847 | (set (make-local-variable 'normal-auto-fill-function) |
| 1552 | 'cperl-do-auto-fill) ; RMS has it as #'cperl-do-auto-fill ??? | 1848 | 'cperl-do-auto-fill) |
| 1553 | (or (fboundp 'cperl-old-auto-fill-mode) | 1849 | (or (fboundp 'cperl-old-auto-fill-mode) |
| 1554 | (progn | 1850 | (progn |
| 1555 | (fset 'cperl-old-auto-fill-mode (symbol-function 'auto-fill-mode)) | 1851 | (fset 'cperl-old-auto-fill-mode (symbol-function 'auto-fill-mode)) |
| @@ -1562,12 +1858,18 @@ or as help on variables `cperl-tips', `cperl-problems', | |||
| 1562 | (if (cperl-val 'cperl-font-lock) | 1858 | (if (cperl-val 'cperl-font-lock) |
| 1563 | (progn (or cperl-faces-init (cperl-init-faces)) | 1859 | (progn (or cperl-faces-init (cperl-init-faces)) |
| 1564 | (font-lock-mode 1)))) | 1860 | (font-lock-mode 1)))) |
| 1861 | (set (make-local-variable 'facemenu-add-face-function) | ||
| 1862 | 'cperl-facemenu-add-face-function) ; XXXX What this guy is for??? | ||
| 1565 | (and (boundp 'msb-menu-cond) | 1863 | (and (boundp 'msb-menu-cond) |
| 1566 | (not cperl-msb-fixed) | 1864 | (not cperl-msb-fixed) |
| 1567 | (cperl-msb-fix)) | 1865 | (cperl-msb-fix)) |
| 1568 | (if (featurep 'easymenu) | 1866 | (if (featurep 'easymenu) |
| 1569 | (easy-menu-add cperl-menu)) ; A NOP in Emacs. | 1867 | (easy-menu-add cperl-menu)) ; A NOP in Emacs. |
| 1570 | (run-mode-hooks 'cperl-mode-hook) | 1868 | (run-mode-hooks 'cperl-mode-hook) |
| 1869 | (if cperl-hook-after-change | ||
| 1870 | (progn | ||
| 1871 | (make-local-hook 'after-change-functions) | ||
| 1872 | (add-hook 'after-change-functions 'cperl-after-change-function nil t))) | ||
| 1571 | ;; After hooks since fontification will break this | 1873 | ;; After hooks since fontification will break this |
| 1572 | (if cperl-pod-here-scan | 1874 | (if cperl-pod-here-scan |
| 1573 | (or cperl-syntaxify-by-font-lock | 1875 | (or cperl-syntaxify-by-font-lock |
| @@ -1616,31 +1918,37 @@ or as help on variables `cperl-tips', `cperl-problems', | |||
| 1616 | (defvar cperl-st-ket '(5 . ?\<)) | 1918 | (defvar cperl-st-ket '(5 . ?\<)) |
| 1617 | 1919 | ||
| 1618 | 1920 | ||
| 1619 | (defun cperl-comment-indent () | 1921 | (defun cperl-comment-indent () ; called at point at supposed comment |
| 1620 | (let ((p (point)) (c (current-column)) was phony) | 1922 | (let ((p (point)) (c (current-column)) was phony) |
| 1621 | (if (looking-at "^#") 0 ; Existing comment at bol stays there. | 1923 | (if (and (not cperl-indent-comment-at-column-0) |
| 1924 | (looking-at "^#")) | ||
| 1925 | 0 ; Existing comment at bol stays there. | ||
| 1622 | ;; Wrong comment found | 1926 | ;; Wrong comment found |
| 1623 | (save-excursion | 1927 | (save-excursion |
| 1624 | (setq was (cperl-to-comment-or-eol) | 1928 | (setq was (cperl-to-comment-or-eol) |
| 1625 | phony (eq (get-text-property (point) 'syntax-table) | 1929 | phony (eq (get-text-property (point) 'syntax-table) |
| 1626 | cperl-st-cfence)) | 1930 | cperl-st-cfence)) |
| 1627 | (if phony | 1931 | (if phony |
| 1628 | (progn | 1932 | (progn ; Too naive??? |
| 1629 | (re-search-forward "#\\|$") ; Hmm, what about embedded #? | 1933 | (re-search-forward "#\\|$") ; Hmm, what about embedded #? |
| 1630 | (if (eq (preceding-char) ?\#) | 1934 | (if (eq (preceding-char) ?\#) |
| 1631 | (forward-char -1)) | 1935 | (forward-char -1)) |
| 1632 | (setq was nil))) | 1936 | (setq was nil))) |
| 1633 | (if (= (point) p) | 1937 | (if (= (point) p) ; Our caller found a correct place |
| 1634 | (progn | 1938 | (progn |
| 1635 | (skip-chars-backward " \t") | 1939 | (skip-chars-backward " \t") |
| 1636 | (max (1+ (current-column)) ; Else indent at comment column | 1940 | (setq was (current-column)) |
| 1637 | comment-column)) | 1941 | (if (eq was 0) |
| 1942 | comment-column | ||
| 1943 | (max (1+ was) ; Else indent at comment column | ||
| 1944 | comment-column))) | ||
| 1945 | ;; No, the caller found a random place; we need to edit ourselves | ||
| 1638 | (if was nil | 1946 | (if was nil |
| 1639 | (insert comment-start) | 1947 | (insert comment-start) |
| 1640 | (backward-char (length comment-start))) | 1948 | (backward-char (length comment-start))) |
| 1641 | (setq cperl-wrong-comment t) | 1949 | (setq cperl-wrong-comment t) |
| 1642 | (indent-to comment-column 1) ; Indent minimum 1 | 1950 | (cperl-make-indent comment-column 1) ; Indent min 1 |
| 1643 | c))))) ; except leave at least one space. | 1951 | c))))) |
| 1644 | 1952 | ||
| 1645 | ;;;(defun cperl-comment-indent-fallback () | 1953 | ;;;(defun cperl-comment-indent-fallback () |
| 1646 | ;;; "Is called if the standard comment-search procedure fails. | 1954 | ;;; "Is called if the standard comment-search procedure fails. |
| @@ -1666,7 +1974,7 @@ or as help on variables `cperl-tips', `cperl-problems', | |||
| 1666 | (interactive) | 1974 | (interactive) |
| 1667 | (let (cperl-wrong-comment) | 1975 | (let (cperl-wrong-comment) |
| 1668 | (indent-for-comment) | 1976 | (indent-for-comment) |
| 1669 | (if cperl-wrong-comment | 1977 | (if cperl-wrong-comment ; set by `cperl-comment-indent' |
| 1670 | (progn (cperl-to-comment-or-eol) | 1978 | (progn (cperl-to-comment-or-eol) |
| 1671 | (forward-char (length comment-start)))))) | 1979 | (forward-char (length comment-start)))))) |
| 1672 | 1980 | ||
| @@ -1966,15 +2274,10 @@ to nil." | |||
| 1966 | (or | 2274 | (or |
| 1967 | (get-text-property (point) 'in-pod) | 2275 | (get-text-property (point) 'in-pod) |
| 1968 | (cperl-after-expr-p nil "{;:") | 2276 | (cperl-after-expr-p nil "{;:") |
| 1969 | (and (re-search-backward | 2277 | (and (re-search-backward "\\(\\`\n?\\|^\n\\)=\\sw+" (point-min) t) |
| 1970 | ;; "\\(\\`\n?\\|\n\n\\)=\\sw+" | 2278 | (not (looking-at "\n*=cut")) |
| 1971 | "\\(\\`\n?\\|^\n\\)=\\sw+" | 2279 | (or (not cperl-use-syntax-table-text-property) |
| 1972 | (point-min) t) | 2280 | (eq (get-text-property (point) 'syntax-type) 'pod)))))) |
| 1973 | (not (or | ||
| 1974 | (looking-at "=cut") | ||
| 1975 | (and cperl-use-syntax-table-text-property | ||
| 1976 | (not (eq (get-text-property (point) 'syntax-type) | ||
| 1977 | 'pod))))))))) | ||
| 1978 | (progn | 2281 | (progn |
| 1979 | (save-excursion | 2282 | (save-excursion |
| 1980 | (setq notlast (re-search-forward "^\n=" nil t))) | 2283 | (setq notlast (re-search-forward "^\n=" nil t))) |
| @@ -2252,7 +2555,7 @@ key. Will untabify if `cperl-electric-backspace-untabify' is non-nil." | |||
| 2252 | 2555 | ||
| 2253 | (put 'cperl-electric-backspace 'delete-selection 'supersede) | 2556 | (put 'cperl-electric-backspace 'delete-selection 'supersede) |
| 2254 | 2557 | ||
| 2255 | (defun cperl-inside-parens-p () | 2558 | (defun cperl-inside-parens-p () ;; NOT USED???? |
| 2256 | (condition-case () | 2559 | (condition-case () |
| 2257 | (save-excursion | 2560 | (save-excursion |
| 2258 | (save-restriction | 2561 | (save-restriction |
| @@ -2332,8 +2635,9 @@ Return the amount the indentation changed by." | |||
| 2332 | (zerop shift-amt)) | 2635 | (zerop shift-amt)) |
| 2333 | (if (> (- (point-max) pos) (point)) | 2636 | (if (> (- (point-max) pos) (point)) |
| 2334 | (goto-char (- (point-max) pos))) | 2637 | (goto-char (- (point-max) pos))) |
| 2335 | (delete-region beg (point)) | 2638 | ;;;(delete-region beg (point)) |
| 2336 | (indent-to indent) | 2639 | ;;;(indent-to indent) |
| 2640 | (cperl-make-indent indent) | ||
| 2337 | ;; If initial point was within line's indentation, | 2641 | ;; If initial point was within line's indentation, |
| 2338 | ;; position after the indentation. Else stay at same point in text. | 2642 | ;; position after the indentation. Else stay at same point in text. |
| 2339 | (if (> (- (point-max) pos) (point)) | 2643 | (if (> (- (point-max) pos) (point)) |
| @@ -2380,63 +2684,55 @@ Return the amount the indentation changed by." | |||
| 2380 | (or state (setq state (parse-partial-sexp start start-point -1 nil start-state))) | 2684 | (or state (setq state (parse-partial-sexp start start-point -1 nil start-state))) |
| 2381 | (list start state depth prestart)))) | 2685 | (list start state depth prestart)))) |
| 2382 | 2686 | ||
| 2383 | (defun cperl-block-p () ; Do not C-M-q ! One string contains ";" ! | ||
| 2384 | ;; Positions is before ?\{. Checks whether it starts a block. | ||
| 2385 | ;; No save-excursion! | ||
| 2386 | (cperl-backward-to-noncomment (point-min)) | ||
| 2387 | (or (memq (preceding-char) (append ";){}$@&%\C-@" nil)) ; Or label! \C-@ at bobp | ||
| 2388 | ; Label may be mixed up with `$blah :' | ||
| 2389 | (save-excursion (cperl-after-label)) | ||
| 2390 | (and (memq (char-syntax (preceding-char)) '(?w ?_)) | ||
| 2391 | (progn | ||
| 2392 | (backward-sexp) | ||
| 2393 | ;; Need take into account `bless', `return', `tr',... | ||
| 2394 | (or (and (looking-at "[a-zA-Z0-9_:]+[ \t\n\f]*[{#]") ; Method call syntax | ||
| 2395 | (not (looking-at "\\(bless\\|return\\|q[wqrx]?\\|tr\\|[smy]\\)\\>"))) | ||
| 2396 | (progn | ||
| 2397 | (skip-chars-backward " \t\n\f") | ||
| 2398 | (and (memq (char-syntax (preceding-char)) '(?w ?_)) | ||
| 2399 | (progn | ||
| 2400 | (backward-sexp) | ||
| 2401 | (looking-at | ||
| 2402 | "sub[ \t]+[a-zA-Z0-9_:]+[ \t\n\f]*\\(([^()]*)[ \t\n\f]*\\)?[#{]"))))))))) | ||
| 2403 | |||
| 2404 | (defvar cperl-look-for-prop '((pod in-pod) (here-doc-delim here-doc-group))) | 2687 | (defvar cperl-look-for-prop '((pod in-pod) (here-doc-delim here-doc-group))) |
| 2405 | 2688 | ||
| 2406 | (defun cperl-calculate-indent (&optional parse-data) ; was parse-start | 2689 | (defun cperl-beginning-of-property (p prop &optional lim) |
| 2407 | "Return appropriate indentation for current line as Perl code. | 2690 | "Given that P has a property PROP, find where the property starts. |
| 2408 | In usual case returns an integer: the column to indent to. | 2691 | Will not look before LIM." |
| 2409 | Returns nil if line starts inside a string, t if in a comment. | 2692 | ;;; XXXX What to do at point-max??? |
| 2410 | 2693 | (or (previous-single-property-change (cperl-1+ p) prop lim) | |
| 2411 | Will not correct the indentation for labels, but will correct it for braces | 2694 | (point-min)) |
| 2412 | and closing parentheses and brackets." | 2695 | ;;; (cond ((eq p (point-min)) |
| 2696 | ;;; p) | ||
| 2697 | ;;; ((and lim (<= p lim)) | ||
| 2698 | ;;; p) | ||
| 2699 | ;;; ((not (get-text-property (1- p) prop)) | ||
| 2700 | ;;; p) | ||
| 2701 | ;;; (t (or (previous-single-property-change p look-prop lim) | ||
| 2702 | ;;; (point-min)))) | ||
| 2703 | ) | ||
| 2704 | |||
| 2705 | (defun cperl-sniff-for-indent (&optional parse-data) ; was parse-start | ||
| 2706 | ;; Old workhorse for calculation of indentation; the major problem | ||
| 2707 | ;; is that it mixes the sniffer logic to understand what the current line | ||
| 2708 | ;; MEANS with the logic to actually calculate where to indent it. | ||
| 2709 | ;; The latter part should be eventually moved to `cperl-calculate-indent'; | ||
| 2710 | ;; actually, this is mostly done now... | ||
| 2413 | (cperl-update-syntaxification (point) (point)) | 2711 | (cperl-update-syntaxification (point) (point)) |
| 2414 | (save-excursion | 2712 | (let ((res (get-text-property (point) 'syntax-type))) |
| 2415 | (if (or | 2713 | (save-excursion |
| 2416 | (and (memq (get-text-property (point) 'syntax-type) | 2714 | (cond |
| 2417 | '(pod here-doc here-doc-delim format)) | 2715 | ((and (memq res '(pod here-doc here-doc-delim format)) |
| 2418 | (not (get-text-property (point) 'indentable))) | 2716 | (not (get-text-property (point) 'indentable))) |
| 2419 | ;; before start of POD - whitespace found since do not have 'pod! | 2717 | (vector res)) |
| 2420 | (and (looking-at "[ \t]*\n=") | 2718 | ;; before start of POD - whitespace found since do not have 'pod! |
| 2421 | (error "Spaces before POD section!")) | 2719 | ((looking-at "[ \t]*\n=") |
| 2422 | (and (not cperl-indent-left-aligned-comments) | 2720 | (error "Spaces before POD section!")) |
| 2423 | (looking-at "^#"))) | 2721 | ((and (not cperl-indent-left-aligned-comments) |
| 2424 | nil | 2722 | (looking-at "^#")) |
| 2425 | (beginning-of-line) | 2723 | [comment-special:at-beginning-of-line]) |
| 2426 | (let ((indent-point (point)) | 2724 | ((get-text-property (point) 'in-pod) |
| 2427 | (char-after (save-excursion | 2725 | [in-pod]) |
| 2428 | (skip-chars-forward " \t") | 2726 | (t |
| 2429 | (following-char))) | 2727 | (beginning-of-line) |
| 2430 | (in-pod (get-text-property (point) 'in-pod)) | 2728 | (let* ((indent-point (point)) |
| 2431 | (pre-indent-point (point)) | 2729 | (char-after-pos (save-excursion |
| 2432 | p prop look-prop is-block delim) | 2730 | (skip-chars-forward " \t") |
| 2433 | (cond | 2731 | (point))) |
| 2434 | (in-pod | 2732 | (char-after (char-after char-after-pos)) |
| 2435 | ;; In the verbatim part, probably code example. What to do??? | 2733 | (pre-indent-point (point)) |
| 2436 | ) | 2734 | p prop look-prop is-block delim) |
| 2437 | (t | 2735 | (save-excursion ; Know we are not in POD, find appropriate pos before |
| 2438 | (save-excursion | ||
| 2439 | ;; Not in POD | ||
| 2440 | (cperl-backward-to-noncomment nil) | 2736 | (cperl-backward-to-noncomment nil) |
| 2441 | (setq p (max (point-min) (1- (point))) | 2737 | (setq p (max (point-min) (1- (point))) |
| 2442 | prop (get-text-property p 'syntax-type) | 2738 | prop (get-text-property p 'syntax-type) |
| @@ -2444,437 +2740,597 @@ and closing parentheses and brackets." | |||
| 2444 | 'syntax-type)) | 2740 | 'syntax-type)) |
| 2445 | (if (memq prop '(pod here-doc format here-doc-delim)) | 2741 | (if (memq prop '(pod here-doc format here-doc-delim)) |
| 2446 | (progn | 2742 | (progn |
| 2447 | (goto-char (or (previous-single-property-change p look-prop) | 2743 | (goto-char (cperl-beginning-of-property p look-prop)) |
| 2448 | (point-min))) | ||
| 2449 | (beginning-of-line) | 2744 | (beginning-of-line) |
| 2450 | (setq pre-indent-point (point))))))) | 2745 | (setq pre-indent-point (point))))) |
| 2451 | (goto-char pre-indent-point) | 2746 | (goto-char pre-indent-point) ; Orig line skipping preceeding pod/etc |
| 2452 | (let* ((case-fold-search nil) | 2747 | (let* ((case-fold-search nil) |
| 2453 | (s-s (cperl-get-state (car parse-data) (nth 1 parse-data))) | 2748 | (s-s (cperl-get-state (car parse-data) (nth 1 parse-data))) |
| 2454 | (start (or (nth 2 parse-data) | 2749 | (start (or (nth 2 parse-data) ; last complete sexp terminated |
| 2455 | (nth 0 s-s))) | 2750 | (nth 0 s-s))) ; Good place to start parsing |
| 2456 | (state (nth 1 s-s)) | 2751 | (state (nth 1 s-s)) |
| 2457 | (containing-sexp (car (cdr state))) | 2752 | (containing-sexp (car (cdr state))) |
| 2458 | old-indent) | 2753 | old-indent) |
| 2459 | (if (and | 2754 | (if (and |
| 2460 | ;;containing-sexp ;; We are buggy at toplevel :-( | 2755 | ;;containing-sexp ;; We are buggy at toplevel :-( |
| 2461 | parse-data) | 2756 | parse-data) |
| 2462 | (progn | 2757 | (progn |
| 2463 | (setcar parse-data pre-indent-point) | 2758 | (setcar parse-data pre-indent-point) |
| 2464 | (setcar (cdr parse-data) state) | 2759 | (setcar (cdr parse-data) state) |
| 2465 | (or (nth 2 parse-data) | 2760 | (or (nth 2 parse-data) |
| 2466 | (setcar (cddr parse-data) start)) | 2761 | (setcar (cddr parse-data) start)) |
| 2467 | ;; Before this point: end of statement | 2762 | ;; Before this point: end of statement |
| 2468 | (setq old-indent (nth 3 parse-data)))) | 2763 | (setq old-indent (nth 3 parse-data)))) |
| 2469 | (cond ((get-text-property (point) 'indentable) | 2764 | (cond ((get-text-property (point) 'indentable) |
| 2470 | ;; indent to just after the surrounding open, | 2765 | ;; indent to "after" the surrounding open |
| 2471 | ;; skip blanks if we do not close the expression. | 2766 | ;; (same offset as `cperl-beautify-regexp-piece'), |
| 2472 | (goto-char (1+ (previous-single-property-change (point) 'indentable))) | 2767 | ;; skip blanks if we do not close the expression. |
| 2473 | (or (memq char-after (append ")]}" nil)) | 2768 | (setq delim ; We do not close the expression |
| 2474 | (looking-at "[ \t]*\\(#\\|$\\)") | 2769 | (get-text-property |
| 2475 | (skip-chars-forward " \t")) | 2770 | (cperl-1+ char-after-pos) 'indentable) |
| 2476 | (current-column)) | 2771 | p (1+ (cperl-beginning-of-property |
| 2477 | ((or (nth 3 state) (nth 4 state)) | 2772 | (point) 'indentable)) |
| 2478 | ;; return nil or t if should not change this line | 2773 | is-block ; misused for: preceeding line in REx |
| 2479 | (nth 4 state)) | 2774 | (save-excursion ; Find preceeding line |
| 2480 | ;; XXXX Do we need to special-case this? | 2775 | (cperl-backward-to-noncomment p) |
| 2481 | ((null containing-sexp) | 2776 | (beginning-of-line) |
| 2482 | ;; Line is at top level. May be data or function definition, | 2777 | (if (<= (point) p) |
| 2483 | ;; or may be function argument declaration. | 2778 | (progn ; get indent from the first line |
| 2484 | ;; Indent like the previous top level line | 2779 | (goto-char p) |
| 2485 | ;; unless that ends in a closeparen without semicolon, | 2780 | (skip-chars-forward " \t") |
| 2486 | ;; in which case this line is the first argument decl. | 2781 | (if (memq (char-after (point)) |
| 2487 | (skip-chars-forward " \t") | 2782 | (append "#\n" nil)) |
| 2488 | (+ (save-excursion | 2783 | nil ; Can't use intentation of this line... |
| 2489 | (goto-char start) | 2784 | (point))) |
| 2490 | (- (current-indentation) | 2785 | (skip-chars-forward " \t") |
| 2491 | (if (nth 2 s-s) cperl-indent-level 0))) | 2786 | (point))) |
| 2492 | (if (= char-after ?{) cperl-continued-brace-offset 0) | 2787 | prop (parse-partial-sexp p char-after-pos)) |
| 2493 | (progn | 2788 | (cond ((not delim) ; End the REx, ignore is-block |
| 2494 | (cperl-backward-to-noncomment (or old-indent (point-min))) | 2789 | (vector 'indentable 'terminator p is-block)) |
| 2495 | ;; Look at previous line that's at column 0 | 2790 | (is-block ; Indent w.r.t. preceeding line |
| 2496 | ;; to determine whether we are in top-level decls | 2791 | (vector 'indentable 'cont-line char-after-pos |
| 2497 | ;; or function's arg decls. Set basic-indent accordingly. | 2792 | is-block char-after p)) |
| 2498 | ;; Now add a little if this is a continuation line. | 2793 | (t ; No preceeding line... |
| 2499 | (if (or (bobp) | 2794 | (vector 'indentable 'first-line p)))) |
| 2500 | (eq (point) old-indent) ; old-indent was at comment | 2795 | ((get-text-property char-after-pos 'REx-part2) |
| 2501 | (eq (preceding-char) ?\;) | 2796 | (vector 'REx-part2 (point))) |
| 2502 | ;; Had ?\) too | 2797 | ((nth 3 state) |
| 2503 | (and (eq (preceding-char) ?\}) | 2798 | [comment]) |
| 2504 | (cperl-after-block-and-statement-beg | 2799 | ((nth 4 state) |
| 2505 | (point-min))) ; Was start - too close | 2800 | [string]) |
| 2506 | (memq char-after (append ")]}" nil)) | 2801 | ;; XXXX Do we need to special-case this? |
| 2507 | (and (eq (preceding-char) ?\:) ; label | 2802 | ((null containing-sexp) |
| 2508 | (progn | 2803 | ;; Line is at top level. May be data or function definition, |
| 2509 | (forward-sexp -1) | 2804 | ;; or may be function argument declaration. |
| 2510 | (skip-chars-backward " \t") | 2805 | ;; Indent like the previous top level line |
| 2511 | (looking-at "[ \t]*[a-zA-Z_][a-zA-Z_0-9]*[ \t]*:"))) | 2806 | ;; unless that ends in a closeparen without semicolon, |
| 2512 | (get-text-property (point) 'first-format-line)) | 2807 | ;; in which case this line is the first argument decl. |
| 2513 | (progn | 2808 | (skip-chars-forward " \t") |
| 2514 | (if (and parse-data | 2809 | (cperl-backward-to-noncomment (or old-indent (point-min))) |
| 2515 | (not (eq char-after ?\C-j))) | 2810 | (setq state |
| 2516 | (setcdr (cddr parse-data) | 2811 | (or (bobp) |
| 2517 | (list pre-indent-point))) | 2812 | (eq (point) old-indent) ; old-indent was at comment |
| 2518 | 0) | 2813 | (eq (preceding-char) ?\;) |
| 2519 | cperl-continued-statement-offset)))) | 2814 | ;; Had ?\) too |
| 2520 | ((not | 2815 | (and (eq (preceding-char) ?\}) |
| 2521 | (or (setq is-block | 2816 | (cperl-after-block-and-statement-beg |
| 2522 | (and (setq delim (= (char-after containing-sexp) ?{)) | 2817 | (point-min))) ; Was start - too close |
| 2523 | (save-excursion ; Is it a hash? | 2818 | (memq char-after (append ")]}" nil)) |
| 2524 | (goto-char containing-sexp) | 2819 | (and (eq (preceding-char) ?\:) ; label |
| 2525 | (cperl-block-p)))) | ||
| 2526 | cperl-indent-parens-as-block)) | ||
| 2527 | ;; group is an expression, not a block: | ||
| 2528 | ;; indent to just after the surrounding open parens, | ||
| 2529 | ;; skip blanks if we do not close the expression. | ||
| 2530 | (goto-char (1+ containing-sexp)) | ||
| 2531 | (or (memq char-after | ||
| 2532 | (append (if delim "}" ")]}") nil)) | ||
| 2533 | (looking-at "[ \t]*\\(#\\|$\\)") | ||
| 2534 | (skip-chars-forward " \t")) | ||
| 2535 | (+ (current-column) | ||
| 2536 | (if (and delim | ||
| 2537 | (eq char-after ?\})) | ||
| 2538 | ;; Correct indentation of trailing ?\} | ||
| 2539 | (+ cperl-indent-level cperl-close-paren-offset) | ||
| 2540 | 0))) | ||
| 2541 | ;;; ((and (/= (char-after containing-sexp) ?{) | ||
| 2542 | ;;; (not cperl-indent-parens-as-block)) | ||
| 2543 | ;;; ;; line is expression, not statement: | ||
| 2544 | ;;; ;; indent to just after the surrounding open, | ||
| 2545 | ;;; ;; skip blanks if we do not close the expression. | ||
| 2546 | ;;; (goto-char (1+ containing-sexp)) | ||
| 2547 | ;;; (or (memq char-after (append ")]}" nil)) | ||
| 2548 | ;;; (looking-at "[ \t]*\\(#\\|$\\)") | ||
| 2549 | ;;; (skip-chars-forward " \t")) | ||
| 2550 | ;;; (current-column)) | ||
| 2551 | ;;; ((progn | ||
| 2552 | ;;; ;; Containing-expr starts with \{. Check whether it is a hash. | ||
| 2553 | ;;; (goto-char containing-sexp) | ||
| 2554 | ;;; (and (not (cperl-block-p)) | ||
| 2555 | ;;; (not cperl-indent-parens-as-block))) | ||
| 2556 | ;;; (goto-char (1+ containing-sexp)) | ||
| 2557 | ;;; (or (eq char-after ?\}) | ||
| 2558 | ;;; (looking-at "[ \t]*\\(#\\|$\\)") | ||
| 2559 | ;;; (skip-chars-forward " \t")) | ||
| 2560 | ;;; (+ (current-column) ; Correct indentation of trailing ?\} | ||
| 2561 | ;;; (if (eq char-after ?\}) (+ cperl-indent-level | ||
| 2562 | ;;; cperl-close-paren-offset) | ||
| 2563 | ;;; 0))) | ||
| 2564 | (t | ||
| 2565 | ;; Statement level. Is it a continuation or a new statement? | ||
| 2566 | ;; Find previous non-comment character. | ||
| 2567 | (goto-char pre-indent-point) | ||
| 2568 | (cperl-backward-to-noncomment containing-sexp) | ||
| 2569 | ;; Back up over label lines, since they don't | ||
| 2570 | ;; affect whether our line is a continuation. | ||
| 2571 | ;; (Had \, too) | ||
| 2572 | (while ;;(or (eq (preceding-char) ?\,) | ||
| 2573 | (and (eq (preceding-char) ?:) | ||
| 2574 | (or ;;(eq (char-after (- (point) 2)) ?\') ; ???? | ||
| 2575 | (memq (char-syntax (char-after (- (point) 2))) | ||
| 2576 | '(?w ?_)))) | ||
| 2577 | ;;) | ||
| 2578 | (if (eq (preceding-char) ?\,) | ||
| 2579 | ;; Will go to beginning of line, essentially. | ||
| 2580 | ;; Will ignore embedded sexpr XXXX. | ||
| 2581 | (cperl-backward-to-start-of-continued-exp containing-sexp)) | ||
| 2582 | (beginning-of-line) | ||
| 2583 | (cperl-backward-to-noncomment containing-sexp)) | ||
| 2584 | ;; Now we get the answer. | ||
| 2585 | (if (not (or (eq (1- (point)) containing-sexp) | ||
| 2586 | (memq (preceding-char) | ||
| 2587 | (append (if is-block " ;{" " ,;{") '(nil))) | ||
| 2588 | (and (eq (preceding-char) ?\}) | ||
| 2589 | (cperl-after-block-and-statement-beg | ||
| 2590 | containing-sexp)) | ||
| 2591 | (get-text-property (point) 'first-format-line))) | ||
| 2592 | ;; This line is continuation of preceding line's statement; | ||
| 2593 | ;; indent `cperl-continued-statement-offset' more than the | ||
| 2594 | ;; previous line of the statement. | ||
| 2595 | ;; | ||
| 2596 | ;; There might be a label on this line, just | ||
| 2597 | ;; consider it bad style and ignore it. | ||
| 2598 | (progn | ||
| 2599 | (cperl-backward-to-start-of-continued-exp containing-sexp) | ||
| 2600 | (+ (if (memq char-after (append "}])" nil)) | ||
| 2601 | 0 ; Closing parenth | ||
| 2602 | cperl-continued-statement-offset) | ||
| 2603 | (if (or is-block | ||
| 2604 | (not delim) | ||
| 2605 | (not (eq char-after ?\}))) | ||
| 2606 | 0 | ||
| 2607 | ;; Now it is a hash reference | ||
| 2608 | (+ cperl-indent-level cperl-close-paren-offset)) | ||
| 2609 | (if (looking-at "\\w+[ \t]*:") | ||
| 2610 | (if (> (current-indentation) cperl-min-label-indent) | ||
| 2611 | (- (current-indentation) cperl-label-offset) | ||
| 2612 | ;; Do not move `parse-data', this should | ||
| 2613 | ;; be quick anyway (this comment comes | ||
| 2614 | ;; from different location): | ||
| 2615 | (cperl-calculate-indent)) | ||
| 2616 | (current-column)) | ||
| 2617 | (if (eq char-after ?\{) | ||
| 2618 | cperl-continued-brace-offset 0))) | ||
| 2619 | ;; This line starts a new statement. | ||
| 2620 | ;; Position following last unclosed open. | ||
| 2621 | (goto-char containing-sexp) | ||
| 2622 | ;; Is line first statement after an open-brace? | ||
| 2623 | (or | ||
| 2624 | ;; If no, find that first statement and indent like | ||
| 2625 | ;; it. If the first statement begins with label, do | ||
| 2626 | ;; not believe when the indentation of the label is too | ||
| 2627 | ;; small. | ||
| 2628 | (save-excursion | ||
| 2629 | (forward-char 1) | ||
| 2630 | (setq old-indent (current-indentation)) | ||
| 2631 | (let ((colon-line-end 0)) | ||
| 2632 | (while | ||
| 2633 | (progn (skip-chars-forward " \t\n") | ||
| 2634 | (looking-at "#\\|[a-zA-Z0-9_$]*:[^:]\\|=[a-zA-Z]")) | ||
| 2635 | ;; Skip over comments and labels following openbrace. | ||
| 2636 | (cond ((= (following-char) ?\#) | ||
| 2637 | (forward-line 1)) | ||
| 2638 | ((= (following-char) ?\=) | ||
| 2639 | (goto-char | ||
| 2640 | (or (next-single-property-change (point) 'in-pod) | ||
| 2641 | (point-max)))) ; do not loop if no syntaxification | ||
| 2642 | ;; label: | ||
| 2643 | (t | ||
| 2644 | (save-excursion (end-of-line) | ||
| 2645 | (setq colon-line-end (point))) | ||
| 2646 | (search-forward ":")))) | ||
| 2647 | ;; The first following code counts | ||
| 2648 | ;; if it is before the line we want to indent. | ||
| 2649 | (and (< (point) indent-point) | ||
| 2650 | (if (> colon-line-end (point)) ; After label | ||
| 2651 | (if (> (current-indentation) | ||
| 2652 | cperl-min-label-indent) | ||
| 2653 | (- (current-indentation) cperl-label-offset) | ||
| 2654 | ;; Do not believe: `max' is involved | ||
| 2655 | (+ old-indent cperl-indent-level)) | ||
| 2656 | (current-column))))) | ||
| 2657 | ;; If no previous statement, | ||
| 2658 | ;; indent it relative to line brace is on. | ||
| 2659 | ;; For open brace in column zero, don't let statement | ||
| 2660 | ;; start there too. If cperl-indent-level is zero, | ||
| 2661 | ;; use cperl-brace-offset + cperl-continued-statement-offset instead. | ||
| 2662 | ;; For open-braces not the first thing in a line, | ||
| 2663 | ;; add in cperl-brace-imaginary-offset. | ||
| 2664 | |||
| 2665 | ;; If first thing on a line: ????? | ||
| 2666 | (+ (if (and (bolp) (zerop cperl-indent-level)) | ||
| 2667 | (+ cperl-brace-offset cperl-continued-statement-offset) | ||
| 2668 | cperl-indent-level) | ||
| 2669 | (if (or is-block | ||
| 2670 | (not delim) | ||
| 2671 | (not (eq char-after ?\}))) | ||
| 2672 | 0 | ||
| 2673 | ;; Now it is a hash reference | ||
| 2674 | (+ cperl-indent-level cperl-close-paren-offset)) | ||
| 2675 | ;; Move back over whitespace before the openbrace. | ||
| 2676 | ;; If openbrace is not first nonwhite thing on the line, | ||
| 2677 | ;; add the cperl-brace-imaginary-offset. | ||
| 2678 | (progn (skip-chars-backward " \t") | ||
| 2679 | (if (bolp) 0 cperl-brace-imaginary-offset)) | ||
| 2680 | ;; If the openbrace is preceded by a parenthesized exp, | ||
| 2681 | ;; move to the beginning of that; | ||
| 2682 | ;; possibly a different line | ||
| 2683 | (progn | ||
| 2684 | (if (eq (preceding-char) ?\)) | ||
| 2685 | (forward-sexp -1)) | ||
| 2686 | ;; In the case it starts a subroutine, indent with | ||
| 2687 | ;; respect to `sub', not with respect to the | ||
| 2688 | ;; first thing on the line, say in the case of | ||
| 2689 | ;; anonymous sub in a hash. | ||
| 2690 | ;; | ||
| 2691 | (skip-chars-backward " \t") | ||
| 2692 | (if (and (eq (preceding-char) ?b) | ||
| 2693 | (progn | 2820 | (progn |
| 2694 | (forward-sexp -1) | 2821 | (forward-sexp -1) |
| 2695 | (looking-at "sub\\>")) | 2822 | (skip-chars-backward " \t") |
| 2696 | (setq old-indent | 2823 | (looking-at "[ \t]*[a-zA-Z_][a-zA-Z_0-9]*[ \t]*:"))) |
| 2697 | (nth 1 | 2824 | (get-text-property (point) 'first-format-line))) |
| 2698 | (parse-partial-sexp | 2825 | |
| 2699 | (save-excursion (beginning-of-line) (point)) | 2826 | ;; Look at previous line that's at column 0 |
| 2700 | (point))))) | 2827 | ;; to determine whether we are in top-level decls |
| 2701 | (progn (goto-char (1+ old-indent)) | 2828 | ;; or function's arg decls. Set basic-indent accordingly. |
| 2702 | (skip-chars-forward " \t") | 2829 | ;; Now add a little if this is a continuation line. |
| 2703 | (current-column)) | 2830 | (and state |
| 2704 | ;; Get initial indentation of the line we are on. | 2831 | parse-data |
| 2705 | ;; If line starts with label, calculate label indentation | 2832 | (not (eq char-after ?\C-j)) |
| 2706 | (if (save-excursion | 2833 | (setcdr (cddr parse-data) |
| 2707 | (beginning-of-line) | 2834 | (list pre-indent-point))) |
| 2708 | (looking-at "[ \t]*[a-zA-Z_][a-zA-Z_0-9]*:[^:]")) | 2835 | (vector 'toplevel start char-after state (nth 2 s-s))) |
| 2709 | (if (> (current-indentation) cperl-min-label-indent) | 2836 | ((not |
| 2710 | (- (current-indentation) cperl-label-offset) | 2837 | (or (setq is-block |
| 2711 | ;; Do not move `parse-data', this should | 2838 | (and (setq delim (= (char-after containing-sexp) ?{)) |
| 2712 | ;; be quick anyway: | 2839 | (save-excursion ; Is it a hash? |
| 2713 | (cperl-calculate-indent)) | 2840 | (goto-char containing-sexp) |
| 2714 | (current-indentation)))))))))))))) | 2841 | (cperl-block-p)))) |
| 2715 | 2842 | cperl-indent-parens-as-block)) | |
| 2716 | ;; (defvar cperl-indent-alist | 2843 | ;; group is an expression, not a block: |
| 2717 | ;; '((string nil) | 2844 | ;; indent to just after the surrounding open parens, |
| 2718 | ;; (comment nil) | 2845 | ;; skip blanks if we do not close the expression. |
| 2719 | ;; (toplevel 0) | 2846 | (goto-char (1+ containing-sexp)) |
| 2720 | ;; (toplevel-after-parenth 2) | 2847 | (or (memq char-after |
| 2721 | ;; (toplevel-continued 2) | 2848 | (append (if delim "}" ")]}") nil)) |
| 2722 | ;; (expression 1)) | 2849 | (looking-at "[ \t]*\\(#\\|$\\)") |
| 2723 | ;; "Alist of indentation rules for CPerl mode. | 2850 | (skip-chars-forward " \t")) |
| 2724 | ;; The values mean: | 2851 | (setq old-indent (point)) ; delim=is-brace |
| 2725 | ;; nil: do not indent; | 2852 | (vector 'in-parens char-after (point) delim containing-sexp)) |
| 2726 | ;; number: add this amount of indentation. | 2853 | (t |
| 2727 | 2854 | ;; Statement level. Is it a continuation or a new statement? | |
| 2728 | ;; Not finished, not used.") | 2855 | ;; Find previous non-comment character. |
| 2729 | 2856 | (goto-char pre-indent-point) ; Skip one level of POD/etc | |
| 2730 | ;; (defun cperl-where-am-i (&optional parse-start start-state) | 2857 | (cperl-backward-to-noncomment containing-sexp) |
| 2731 | ;; ;; Unfinished | 2858 | ;; Back up over label lines, since they don't |
| 2732 | ;; "Return a list of lists ((TYPE POS)...) of good points before the point. | 2859 | ;; affect whether our line is a continuation. |
| 2733 | ;; ;; POS may be nil if it is hard to find, say, when TYPE is `string' or `comment'. | 2860 | ;; (Had \, too) |
| 2734 | 2861 | (while;;(or (eq (preceding-char) ?\,) | |
| 2735 | ;; ;; Not finished, not used." | 2862 | (and (eq (preceding-char) ?:) |
| 2736 | ;; (save-excursion | 2863 | (or;;(eq (char-after (- (point) 2)) ?\') ; ???? |
| 2737 | ;; (let* ((start-point (point)) | 2864 | (memq (char-syntax (char-after (- (point) 2))) |
| 2738 | ;; (s-s (cperl-get-state)) | 2865 | '(?w ?_)))) |
| 2739 | ;; (start (nth 0 s-s)) | 2866 | ;;) |
| 2740 | ;; (state (nth 1 s-s)) | 2867 | ;; This is always FALSE? |
| 2741 | ;; (prestart (nth 3 s-s)) | 2868 | (if (eq (preceding-char) ?\,) |
| 2742 | ;; (containing-sexp (car (cdr state))) | 2869 | ;; Will go to beginning of line, essentially. |
| 2743 | ;; (case-fold-search nil) | 2870 | ;; Will ignore embedded sexpr XXXX. |
| 2744 | ;; (res (list (list 'parse-start start) (list 'parse-prestart prestart)))) | 2871 | (cperl-backward-to-start-of-continued-exp containing-sexp)) |
| 2745 | ;; (cond ((nth 3 state) ; In string | 2872 | (beginning-of-line) |
| 2746 | ;; (setq res (cons (list 'string nil (nth 3 state)) res))) ; What started string | 2873 | (cperl-backward-to-noncomment containing-sexp)) |
| 2747 | ;; ((nth 4 state) ; In comment | 2874 | ;; Now we get non-label preceeding the indent point |
| 2748 | ;; (setq res (cons '(comment) res))) | 2875 | (if (not (or (eq (1- (point)) containing-sexp) |
| 2749 | ;; ((null containing-sexp) | 2876 | (memq (preceding-char) |
| 2750 | ;; ;; Line is at top level. | 2877 | (append (if is-block " ;{" " ,;{") '(nil))) |
| 2751 | ;; ;; Indent like the previous top level line | 2878 | (and (eq (preceding-char) ?\}) |
| 2752 | ;; ;; unless that ends in a closeparen without semicolon, | 2879 | (cperl-after-block-and-statement-beg |
| 2753 | ;; ;; in which case this line is the first argument decl. | 2880 | containing-sexp)) |
| 2754 | ;; (cperl-backward-to-noncomment (or parse-start (point-min))) | 2881 | (get-text-property (point) 'first-format-line))) |
| 2755 | ;; ;;(skip-chars-backward " \t\f\n") | 2882 | ;; This line is continuation of preceding line's statement; |
| 2756 | ;; (cond | 2883 | ;; indent `cperl-continued-statement-offset' more than the |
| 2757 | ;; ((or (bobp) | 2884 | ;; previous line of the statement. |
| 2758 | ;; (memq (preceding-char) (append ";}" nil))) | 2885 | ;; |
| 2759 | ;; (setq res (cons (list 'toplevel start) res))) | 2886 | ;; There might be a label on this line, just |
| 2760 | ;; ((eq (preceding-char) ?\) ) | 2887 | ;; consider it bad style and ignore it. |
| 2761 | ;; (setq res (cons (list 'toplevel-after-parenth start) res))) | 2888 | (progn |
| 2762 | ;; (t | 2889 | (cperl-backward-to-start-of-continued-exp containing-sexp) |
| 2763 | ;; (setq res (cons (list 'toplevel-continued start) res))))) | 2890 | (vector 'continuation (point) char-after is-block delim)) |
| 2764 | ;; ((/= (char-after containing-sexp) ?{) | 2891 | ;; This line starts a new statement. |
| 2765 | ;; ;; line is expression, not statement: | 2892 | ;; Position following last unclosed open brace |
| 2766 | ;; ;; indent to just after the surrounding open. | 2893 | (goto-char containing-sexp) |
| 2767 | ;; ;; skip blanks if we do not close the expression. | 2894 | ;; Is line first statement after an open-brace? |
| 2768 | ;; (setq res (cons (list 'expression-blanks | 2895 | (or |
| 2769 | ;; (progn | 2896 | ;; If no, find that first statement and indent like |
| 2770 | ;; (goto-char (1+ containing-sexp)) | 2897 | ;; it. If the first statement begins with label, do |
| 2771 | ;; (or (looking-at "[ \t]*\\(#\\|$\\)") | 2898 | ;; not believe when the indentation of the label is too |
| 2772 | ;; (skip-chars-forward " \t")) | 2899 | ;; small. |
| 2773 | ;; (point))) | 2900 | (save-excursion |
| 2774 | ;; (cons (list 'expression containing-sexp) res)))) | 2901 | (forward-char 1) |
| 2775 | ;; ((progn | 2902 | (let ((colon-line-end 0)) |
| 2776 | ;; ;; Containing-expr starts with \{. Check whether it is a hash. | 2903 | (while |
| 2777 | ;; (goto-char containing-sexp) | 2904 | (progn (skip-chars-forward " \t\n") |
| 2778 | ;; (not (cperl-block-p))) | 2905 | (looking-at "#\\|[a-zA-Z0-9_$]*:[^:]\\|=[a-zA-Z]")) |
| 2779 | ;; (setq res (cons (list 'expression-blanks | 2906 | ;; Skip over comments and labels following openbrace. |
| 2780 | ;; (progn | 2907 | (cond ((= (following-char) ?\#) |
| 2781 | ;; (goto-char (1+ containing-sexp)) | 2908 | (forward-line 1)) |
| 2782 | ;; (or (looking-at "[ \t]*\\(#\\|$\\)") | 2909 | ((= (following-char) ?\=) |
| 2783 | ;; (skip-chars-forward " \t")) | 2910 | (goto-char |
| 2784 | ;; (point))) | 2911 | (or (next-single-property-change (point) 'in-pod) |
| 2785 | ;; (cons (list 'expression containing-sexp) res)))) | 2912 | (point-max)))) ; do not loop if no syntaxification |
| 2786 | ;; (t | 2913 | ;; label: |
| 2787 | ;; ;; Statement level. | 2914 | (t |
| 2788 | ;; (setq res (cons (list 'in-block containing-sexp) res)) | 2915 | (save-excursion (end-of-line) |
| 2789 | ;; ;; Is it a continuation or a new statement? | 2916 | (setq colon-line-end (point))) |
| 2790 | ;; ;; Find previous non-comment character. | 2917 | (search-forward ":")))) |
| 2791 | ;; (cperl-backward-to-noncomment containing-sexp) | 2918 | ;; We are at beginning of code (NOT label or comment) |
| 2792 | ;; ;; Back up over label lines, since they don't | 2919 | ;; First, the following code counts |
| 2793 | ;; ;; affect whether our line is a continuation. | 2920 | ;; if it is before the line we want to indent. |
| 2794 | ;; ;; Back up comma-delimited lines too ????? | 2921 | (and (< (point) indent-point) |
| 2795 | ;; (while (or (eq (preceding-char) ?\,) | 2922 | (vector 'have-prev-sibling (point) colon-line-end |
| 2796 | ;; (save-excursion (cperl-after-label))) | 2923 | containing-sexp)))) |
| 2797 | ;; (if (eq (preceding-char) ?\,) | 2924 | (progn |
| 2798 | ;; ;; Will go to beginning of line, essentially | 2925 | ;; If no previous statement, |
| 2799 | ;; ;; Will ignore embedded sexpr XXXX. | 2926 | ;; indent it relative to line brace is on. |
| 2800 | ;; (cperl-backward-to-start-of-continued-exp containing-sexp)) | 2927 | |
| 2801 | ;; (beginning-of-line) | 2928 | ;; For open-braces not the first thing in a line, |
| 2802 | ;; (cperl-backward-to-noncomment containing-sexp)) | 2929 | ;; add in cperl-brace-imaginary-offset. |
| 2803 | ;; ;; Now we get the answer. | 2930 | |
| 2804 | ;; (if (not (memq (preceding-char) (append ";}{" '(nil)))) ; Was ?\, | 2931 | ;; If first thing on a line: ????? |
| 2805 | ;; ;; This line is continuation of preceding line's statement. | 2932 | ;; Move back over whitespace before the openbrace. |
| 2806 | ;; (list (list 'statement-continued containing-sexp)) | 2933 | (setq ; brace first thing on a line |
| 2807 | ;; ;; This line starts a new statement. | 2934 | old-indent (progn (skip-chars-backward " \t") (bolp))) |
| 2808 | ;; ;; Position following last unclosed open. | 2935 | ;; Should we indent w.r.t. earlier than start? |
| 2809 | ;; (goto-char containing-sexp) | 2936 | ;; Move to start of control group, possibly on a different line |
| 2810 | ;; ;; Is line first statement after an open-brace? | 2937 | (or cperl-indent-wrt-brace |
| 2811 | ;; (or | 2938 | (cperl-backward-to-noncomment (point-min))) |
| 2812 | ;; ;; If no, find that first statement and indent like | 2939 | ;; If the openbrace is preceded by a parenthesized exp, |
| 2813 | ;; ;; it. If the first statement begins with label, do | 2940 | ;; move to the beginning of that; |
| 2814 | ;; ;; not believe when the indentation of the label is too | 2941 | (if (eq (preceding-char) ?\)) |
| 2815 | ;; ;; small. | 2942 | (progn |
| 2816 | ;; (save-excursion | 2943 | (forward-sexp -1) |
| 2817 | ;; (forward-char 1) | 2944 | (cperl-backward-to-noncomment (point-min)))) |
| 2818 | ;; (let ((colon-line-end 0)) | 2945 | ;; In the case it starts a subroutine, indent with |
| 2819 | ;; (while (progn (skip-chars-forward " \t\n" start-point) | 2946 | ;; respect to `sub', not with respect to the |
| 2820 | ;; (and (< (point) start-point) | 2947 | ;; first thing on the line, say in the case of |
| 2821 | ;; (looking-at | 2948 | ;; anonymous sub in a hash. |
| 2822 | ;; "#\\|[a-zA-Z_][a-zA-Z0-9_]*:[^:]"))) | 2949 | (if (and;; Is it a sub in group starting on this line? |
| 2823 | ;; ;; Skip over comments and labels following openbrace. | 2950 | (cond ((get-text-property (point) 'attrib-group) |
| 2824 | ;; (cond ((= (following-char) ?\#) | 2951 | (goto-char (cperl-beginning-of-property |
| 2825 | ;; ;;(forward-line 1) | 2952 | (point) 'attrib-group))) |
| 2826 | ;; (end-of-line)) | 2953 | ((eq (preceding-char) ?b) |
| 2827 | ;; ;; label: | 2954 | (forward-sexp -1) |
| 2828 | ;; (t | 2955 | (looking-at "sub\\>"))) |
| 2829 | ;; (save-excursion (end-of-line) | 2956 | (setq p (nth 1 ; start of innermost containing list |
| 2830 | ;; (setq colon-line-end (point))) | 2957 | (parse-partial-sexp |
| 2831 | ;; (search-forward ":")))) | 2958 | (save-excursion (beginning-of-line) |
| 2832 | ;; ;; Now at the point, after label, or at start | 2959 | (point)) |
| 2833 | ;; ;; of first statement in the block. | 2960 | (point))))) |
| 2834 | ;; (and (< (point) start-point) | 2961 | (progn |
| 2835 | ;; (if (> colon-line-end (point)) | 2962 | (goto-char (1+ p)) ; enclosing block on the same line |
| 2836 | ;; ;; Before statement after label | 2963 | (skip-chars-forward " \t") |
| 2837 | ;; (if (> (current-indentation) | 2964 | (vector 'code-start-in-block containing-sexp char-after |
| 2838 | ;; cperl-min-label-indent) | 2965 | (and delim (not is-block)) ; is a HASH |
| 2839 | ;; (list (list 'label-in-block (point))) | 2966 | old-indent ; brace first thing on a line |
| 2840 | ;; ;; Do not believe: `max' is involved | 2967 | t (point) ; have something before... |
| 2841 | ;; (list | 2968 | ) |
| 2842 | ;; (list 'label-in-block-min-indent (point)))) | 2969 | ;;(current-column) |
| 2843 | ;; ;; Before statement | 2970 | ) |
| 2844 | ;; (list 'statement-in-block (point)))))) | 2971 | ;; Get initial indentation of the line we are on. |
| 2845 | ;; ;; If no previous statement, | 2972 | ;; If line starts with label, calculate label indentation |
| 2846 | ;; ;; indent it relative to line brace is on. | 2973 | (vector 'code-start-in-block containing-sexp char-after |
| 2847 | ;; ;; For open brace in column zero, don't let statement | 2974 | (and delim (not is-block)) ; is a HASH |
| 2848 | ;; ;; start there too. If cperl-indent-level is zero, | 2975 | old-indent ; brace first thing on a line |
| 2849 | ;; ;; use cperl-brace-offset + cperl-continued-statement-offset instead. | 2976 | nil (point) ; nothing interesting before |
| 2850 | ;; ;; For open-braces not the first thing in a line, | 2977 | )))))))))))))) |
| 2851 | ;; ;; add in cperl-brace-imaginary-offset. | 2978 | |
| 2852 | 2979 | (defvar cperl-indent-rules-alist | |
| 2853 | ;; ;; If first thing on a line: ????? | 2980 | '((pod nil) ; via `syntax-type' property |
| 2854 | ;; (+ (if (and (bolp) (zerop cperl-indent-level)) | 2981 | (here-doc nil) ; via `syntax-type' property |
| 2855 | ;; (+ cperl-brace-offset cperl-continued-statement-offset) | 2982 | (here-doc-delim nil) ; via `syntax-type' property |
| 2856 | ;; cperl-indent-level) | 2983 | (format nil) ; via `syntax-type' property |
| 2857 | ;; ;; Move back over whitespace before the openbrace. | 2984 | (in-pod nil) ; via `in-pod' property |
| 2858 | ;; ;; If openbrace is not first nonwhite thing on the line, | 2985 | (comment-special:at-beginning-of-line nil) |
| 2859 | ;; ;; add the cperl-brace-imaginary-offset. | 2986 | (string t) |
| 2860 | ;; (progn (skip-chars-backward " \t") | 2987 | (comment nil)) |
| 2861 | ;; (if (bolp) 0 cperl-brace-imaginary-offset)) | 2988 | "Alist of indentation rules for CPerl mode. |
| 2862 | ;; ;; If the openbrace is preceded by a parenthesized exp, | 2989 | The values mean: |
| 2863 | ;; ;; move to the beginning of that; | 2990 | nil: do not indent; |
| 2864 | ;; ;; possibly a different line | 2991 | number: add this amount of indentation. |
| 2865 | ;; (progn | 2992 | |
| 2866 | ;; (if (eq (preceding-char) ?\)) | 2993 | Not finished.") |
| 2867 | ;; (forward-sexp -1)) | 2994 | |
| 2868 | ;; ;; Get initial indentation of the line we are on. | 2995 | (defun cperl-calculate-indent (&optional parse-data) ; was parse-start |
| 2869 | ;; ;; If line starts with label, calculate label indentation | 2996 | "Return appropriate indentation for current line as Perl code. |
| 2870 | ;; (if (save-excursion | 2997 | In usual case returns an integer: the column to indent to. |
| 2871 | ;; (beginning-of-line) | 2998 | Returns nil if line starts inside a string, t if in a comment. |
| 2872 | ;; (looking-at "[ \t]*[a-zA-Z_][a-zA-Z_0-9]*:[^:]")) | 2999 | |
| 2873 | ;; (if (> (current-indentation) cperl-min-label-indent) | 3000 | Will not correct the indentation for labels, but will correct it for braces |
| 2874 | ;; (- (current-indentation) cperl-label-offset) | 3001 | and closing parentheses and brackets." |
| 2875 | ;; (cperl-calculate-indent)) | 3002 | ;; This code is still a broken architecture: in some cases we need to |
| 2876 | ;; (current-indentation)))))))) | 3003 | ;; compensate for some modifications which `cperl-indent-line' will add later |
| 2877 | ;; res))) | 3004 | (save-excursion |
| 3005 | (let ((i (cperl-sniff-for-indent parse-data)) what p) | ||
| 3006 | (cond | ||
| 3007 | ;;((or (null i) (eq i t) (numberp i)) | ||
| 3008 | ;; i) | ||
| 3009 | ((vectorp i) | ||
| 3010 | (setq what (assoc (elt i 0) cperl-indent-rules-alist)) | ||
| 3011 | (cond | ||
| 3012 | (what (cadr what)) ; Load from table | ||
| 3013 | ;; | ||
| 3014 | ;; Indenters for regular expressions with //x and qw() | ||
| 3015 | ;; | ||
| 3016 | ((eq 'REx-part2 (elt i 0)) ;; [self start] start of /REP in s//REP/x | ||
| 3017 | (goto-char (elt i 1)) | ||
| 3018 | (condition-case nil ; Use indentation of the 1st part | ||
| 3019 | (forward-sexp -1)) | ||
| 3020 | (current-column)) | ||
| 3021 | ((eq 'indentable (elt i 0)) ; Indenter for REGEXP qw() etc | ||
| 3022 | (cond ;;; [indentable terminator start-pos is-block] | ||
| 3023 | ((eq 'terminator (elt i 1)) ; Lone terminator of "indentable string" | ||
| 3024 | (goto-char (elt i 2)) ; After opening parens | ||
| 3025 | (1- (current-column))) | ||
| 3026 | ((eq 'first-line (elt i 1)); [indentable first-line start-pos] | ||
| 3027 | (goto-char (elt i 2)) | ||
| 3028 | (+ (or cperl-regexp-indent-step cperl-indent-level) | ||
| 3029 | -1 | ||
| 3030 | (current-column))) | ||
| 3031 | ((eq 'cont-line (elt i 1)); [indentable cont-line pos prev-pos first-char start-pos] | ||
| 3032 | ;; Indent as the level after closing parens | ||
| 3033 | (goto-char (elt i 2)) ; indent line | ||
| 3034 | (skip-chars-forward " \t)") ; Skip closing parens | ||
| 3035 | (setq p (point)) | ||
| 3036 | (goto-char (elt i 3)) ; previous line | ||
| 3037 | (skip-chars-forward " \t)") ; Skip closing parens | ||
| 3038 | ;; Number of parens in between: | ||
| 3039 | (setq p (nth 0 (parse-partial-sexp (point) p)) | ||
| 3040 | what (elt i 4)) ; First char on current line | ||
| 3041 | (goto-char (elt i 3)) ; previous line | ||
| 3042 | (+ (* p (or cperl-regexp-indent-step cperl-indent-level)) | ||
| 3043 | (cond ((eq what ?\) ) | ||
| 3044 | (- cperl-close-paren-offset)) ; compensate | ||
| 3045 | ((eq what ?\| ) | ||
| 3046 | (- (or cperl-regexp-indent-step cperl-indent-level))) | ||
| 3047 | (t 0)) | ||
| 3048 | (if (eq (following-char) ?\| ) | ||
| 3049 | (or cperl-regexp-indent-step cperl-indent-level) | ||
| 3050 | 0) | ||
| 3051 | (current-column))) | ||
| 3052 | (t | ||
| 3053 | (error "Unrecognized value of indent: %s" i)))) | ||
| 3054 | ;; | ||
| 3055 | ;; Indenter for stuff at toplevel | ||
| 3056 | ;; | ||
| 3057 | ((eq 'toplevel (elt i 0)) ;; [toplevel start char-after state immed-after-block] | ||
| 3058 | (+ (save-excursion ; To beg-of-defun, or end of last sexp | ||
| 3059 | (goto-char (elt i 1)) ; start = Good place to start parsing | ||
| 3060 | (- (current-indentation) ; | ||
| 3061 | (if (elt i 4) cperl-indent-level 0))) ; immed-after-block | ||
| 3062 | (if (eq (elt i 2) ?{) cperl-continued-brace-offset 0) ; char-after | ||
| 3063 | ;; Look at previous line that's at column 0 | ||
| 3064 | ;; to determine whether we are in top-level decls | ||
| 3065 | ;; or function's arg decls. Set basic-indent accordingly. | ||
| 3066 | ;; Now add a little if this is a continuation line. | ||
| 3067 | (if (elt i 3) ; state (XXX What is the semantic???) | ||
| 3068 | 0 | ||
| 3069 | cperl-continued-statement-offset))) | ||
| 3070 | ;; | ||
| 3071 | ;; Indenter for stuff in "parentheses" (or brackets, braces-as-hash) | ||
| 3072 | ;; | ||
| 3073 | ((eq 'in-parens (elt i 0)) | ||
| 3074 | ;; in-parens char-after old-indent-point is-brace containing-sexp | ||
| 3075 | |||
| 3076 | ;; group is an expression, not a block: | ||
| 3077 | ;; indent to just after the surrounding open parens, | ||
| 3078 | ;; skip blanks if we do not close the expression. | ||
| 3079 | (+ (progn | ||
| 3080 | (goto-char (elt i 2)) ; old-indent-point | ||
| 3081 | (current-column)) | ||
| 3082 | (if (and (elt i 3) ; is-brace | ||
| 3083 | (eq (elt i 1) ?\})) ; char-after | ||
| 3084 | ;; Correct indentation of trailing ?\} | ||
| 3085 | (+ cperl-indent-level cperl-close-paren-offset) | ||
| 3086 | 0))) | ||
| 3087 | ;; | ||
| 3088 | ;; Indenter for continuation lines | ||
| 3089 | ;; | ||
| 3090 | ((eq 'continuation (elt i 0)) | ||
| 3091 | ;; [continuation statement-start char-after is-block is-brace] | ||
| 3092 | (goto-char (elt i 1)) ; statement-start | ||
| 3093 | (+ (if (memq (elt i 2) (append "}])" nil)) ; char-after | ||
| 3094 | 0 ; Closing parenth | ||
| 3095 | cperl-continued-statement-offset) | ||
| 3096 | (if (or (elt i 3) ; is-block | ||
| 3097 | (not (elt i 4)) ; is-brace | ||
| 3098 | (not (eq (elt i 2) ?\}))) ; char-after | ||
| 3099 | 0 | ||
| 3100 | ;; Now it is a hash reference | ||
| 3101 | (+ cperl-indent-level cperl-close-paren-offset)) | ||
| 3102 | ;; Labels do not take :: ... | ||
| 3103 | (if (looking-at "\\(\\w\\|_\\)+[ \t]*:") | ||
| 3104 | (if (> (current-indentation) cperl-min-label-indent) | ||
| 3105 | (- (current-indentation) cperl-label-offset) | ||
| 3106 | ;; Do not move `parse-data', this should | ||
| 3107 | ;; be quick anyway (this comment comes | ||
| 3108 | ;; from different location): | ||
| 3109 | (cperl-calculate-indent)) | ||
| 3110 | (current-column)) | ||
| 3111 | (if (eq (elt i 2) ?\{) ; char-after | ||
| 3112 | cperl-continued-brace-offset 0))) | ||
| 3113 | ;; | ||
| 3114 | ;; Indenter for lines in a block which are not leading lines | ||
| 3115 | ;; | ||
| 3116 | ((eq 'have-prev-sibling (elt i 0)) | ||
| 3117 | ;; [have-prev-sibling sibling-beg colon-line-end block-start] | ||
| 3118 | (goto-char (elt i 1)) | ||
| 3119 | (if (> (elt i 2) (point)) ; colon-line-end; After-label, same line | ||
| 3120 | (if (> (current-indentation) | ||
| 3121 | cperl-min-label-indent) | ||
| 3122 | (- (current-indentation) cperl-label-offset) | ||
| 3123 | ;; Do not believe: `max' was involved in calculation of indent | ||
| 3124 | (+ cperl-indent-level | ||
| 3125 | (save-excursion | ||
| 3126 | (goto-char (elt i 3)) ; block-start | ||
| 3127 | (current-indentation)))) | ||
| 3128 | (current-column))) | ||
| 3129 | ;; | ||
| 3130 | ;; Indenter for the first line in a block | ||
| 3131 | ;; | ||
| 3132 | ((eq 'code-start-in-block (elt i 0)) | ||
| 3133 | ;;[code-start-in-block before-brace char-after | ||
| 3134 | ;; is-a-HASH-ref brace-is-first-thing-on-a-line | ||
| 3135 | ;; group-starts-before-start-of-sub start-of-control-group] | ||
| 3136 | (goto-char (elt i 1)) | ||
| 3137 | ;; For open brace in column zero, don't let statement | ||
| 3138 | ;; start there too. If cperl-indent-level=0, | ||
| 3139 | ;; use cperl-brace-offset + cperl-continued-statement-offset instead. | ||
| 3140 | (+ (if (and (bolp) (zerop cperl-indent-level)) | ||
| 3141 | (+ cperl-brace-offset cperl-continued-statement-offset) | ||
| 3142 | cperl-indent-level) | ||
| 3143 | (if (and (elt i 3) ; is-a-HASH-ref | ||
| 3144 | (eq (elt i 2) ?\})) ; char-after: End of a hash reference | ||
| 3145 | (+ cperl-indent-level cperl-close-paren-offset) | ||
| 3146 | 0) | ||
| 3147 | ;; Unless openbrace is the first nonwhite thing on the line, | ||
| 3148 | ;; add the cperl-brace-imaginary-offset. | ||
| 3149 | (if (elt i 4) 0 ; brace-is-first-thing-on-a-line | ||
| 3150 | cperl-brace-imaginary-offset) | ||
| 3151 | (progn | ||
| 3152 | (goto-char (elt i 6)) ; start-of-control-group | ||
| 3153 | (if (elt i 5) ; group-starts-before-start-of-sub | ||
| 3154 | (current-column) | ||
| 3155 | ;; Get initial indentation of the line we are on. | ||
| 3156 | ;; If line starts with label, calculate label indentation | ||
| 3157 | (if (save-excursion | ||
| 3158 | (beginning-of-line) | ||
| 3159 | (looking-at "[ \t]*[a-zA-Z_][a-zA-Z_0-9]*:[^:]")) | ||
| 3160 | (if (> (current-indentation) cperl-min-label-indent) | ||
| 3161 | (- (current-indentation) cperl-label-offset) | ||
| 3162 | ;; Do not move `parse-data', this should | ||
| 3163 | ;; be quick anyway: | ||
| 3164 | (cperl-calculate-indent)) | ||
| 3165 | (current-indentation)))))) | ||
| 3166 | (t | ||
| 3167 | (error "Unrecognized value of indent: %s" i)))) | ||
| 3168 | (t | ||
| 3169 | (error "Got strange value of indent: %s" i)))))) | ||
| 3170 | |||
| 3171 | (defvar cperl-indent-alist | ||
| 3172 | '((string nil) | ||
| 3173 | (comment nil) | ||
| 3174 | (toplevel 0) | ||
| 3175 | (toplevel-after-parenth 2) | ||
| 3176 | (toplevel-continued 2) | ||
| 3177 | (expression 1)) | ||
| 3178 | "Alist of indentation rules for CPerl mode. | ||
| 3179 | The values mean: | ||
| 3180 | nil: do not indent; | ||
| 3181 | number: add this amount of indentation. | ||
| 3182 | |||
| 3183 | Not finished, not used.") | ||
| 3184 | |||
| 3185 | (defun cperl-where-am-i (&optional parse-start start-state) | ||
| 3186 | ;; Unfinished | ||
| 3187 | "Return a list of lists ((TYPE POS)...) of good points before the point. | ||
| 3188 | POS may be nil if it is hard to find, say, when TYPE is `string' or `comment'. | ||
| 3189 | |||
| 3190 | Not finished, not used." | ||
| 3191 | (save-excursion | ||
| 3192 | (let* ((start-point (point)) unused | ||
| 3193 | (s-s (cperl-get-state)) | ||
| 3194 | (start (nth 0 s-s)) | ||
| 3195 | (state (nth 1 s-s)) | ||
| 3196 | (prestart (nth 3 s-s)) | ||
| 3197 | (containing-sexp (car (cdr state))) | ||
| 3198 | (case-fold-search nil) | ||
| 3199 | (res (list (list 'parse-start start) (list 'parse-prestart prestart)))) | ||
| 3200 | (cond ((nth 3 state) ; In string | ||
| 3201 | (setq res (cons (list 'string nil (nth 3 state)) res))) ; What started string | ||
| 3202 | ((nth 4 state) ; In comment | ||
| 3203 | (setq res (cons '(comment) res))) | ||
| 3204 | ((null containing-sexp) | ||
| 3205 | ;; Line is at top level. | ||
| 3206 | ;; Indent like the previous top level line | ||
| 3207 | ;; unless that ends in a closeparen without semicolon, | ||
| 3208 | ;; in which case this line is the first argument decl. | ||
| 3209 | (cperl-backward-to-noncomment (or parse-start (point-min))) | ||
| 3210 | ;;(skip-chars-backward " \t\f\n") | ||
| 3211 | (cond | ||
| 3212 | ((or (bobp) | ||
| 3213 | (memq (preceding-char) (append ";}" nil))) | ||
| 3214 | (setq res (cons (list 'toplevel start) res))) | ||
| 3215 | ((eq (preceding-char) ?\) ) | ||
| 3216 | (setq res (cons (list 'toplevel-after-parenth start) res))) | ||
| 3217 | (t | ||
| 3218 | (setq res (cons (list 'toplevel-continued start) res))))) | ||
| 3219 | ((/= (char-after containing-sexp) ?{) | ||
| 3220 | ;; line is expression, not statement: | ||
| 3221 | ;; indent to just after the surrounding open. | ||
| 3222 | ;; skip blanks if we do not close the expression. | ||
| 3223 | (setq res (cons (list 'expression-blanks | ||
| 3224 | (progn | ||
| 3225 | (goto-char (1+ containing-sexp)) | ||
| 3226 | (or (looking-at "[ \t]*\\(#\\|$\\)") | ||
| 3227 | (skip-chars-forward " \t")) | ||
| 3228 | (point))) | ||
| 3229 | (cons (list 'expression containing-sexp) res)))) | ||
| 3230 | ((progn | ||
| 3231 | ;; Containing-expr starts with \{. Check whether it is a hash. | ||
| 3232 | (goto-char containing-sexp) | ||
| 3233 | (not (cperl-block-p))) | ||
| 3234 | (setq res (cons (list 'expression-blanks | ||
| 3235 | (progn | ||
| 3236 | (goto-char (1+ containing-sexp)) | ||
| 3237 | (or (looking-at "[ \t]*\\(#\\|$\\)") | ||
| 3238 | (skip-chars-forward " \t")) | ||
| 3239 | (point))) | ||
| 3240 | (cons (list 'expression containing-sexp) res)))) | ||
| 3241 | (t | ||
| 3242 | ;; Statement level. | ||
| 3243 | (setq res (cons (list 'in-block containing-sexp) res)) | ||
| 3244 | ;; Is it a continuation or a new statement? | ||
| 3245 | ;; Find previous non-comment character. | ||
| 3246 | (cperl-backward-to-noncomment containing-sexp) | ||
| 3247 | ;; Back up over label lines, since they don't | ||
| 3248 | ;; affect whether our line is a continuation. | ||
| 3249 | ;; Back up comma-delimited lines too ????? | ||
| 3250 | (while (or (eq (preceding-char) ?\,) | ||
| 3251 | (save-excursion (cperl-after-label))) | ||
| 3252 | (if (eq (preceding-char) ?\,) | ||
| 3253 | ;; Will go to beginning of line, essentially | ||
| 3254 | ;; Will ignore embedded sexpr XXXX. | ||
| 3255 | (cperl-backward-to-start-of-continued-exp containing-sexp)) | ||
| 3256 | (beginning-of-line) | ||
| 3257 | (cperl-backward-to-noncomment containing-sexp)) | ||
| 3258 | ;; Now we get the answer. | ||
| 3259 | (if (not (memq (preceding-char) (append ";}{" '(nil)))) ; Was ?\, | ||
| 3260 | ;; This line is continuation of preceding line's statement. | ||
| 3261 | (list (list 'statement-continued containing-sexp)) | ||
| 3262 | ;; This line starts a new statement. | ||
| 3263 | ;; Position following last unclosed open. | ||
| 3264 | (goto-char containing-sexp) | ||
| 3265 | ;; Is line first statement after an open-brace? | ||
| 3266 | (or | ||
| 3267 | ;; If no, find that first statement and indent like | ||
| 3268 | ;; it. If the first statement begins with label, do | ||
| 3269 | ;; not believe when the indentation of the label is too | ||
| 3270 | ;; small. | ||
| 3271 | (save-excursion | ||
| 3272 | (forward-char 1) | ||
| 3273 | (let ((colon-line-end 0)) | ||
| 3274 | (while (progn (skip-chars-forward " \t\n" start-point) | ||
| 3275 | (and (< (point) start-point) | ||
| 3276 | (looking-at | ||
| 3277 | "#\\|[a-zA-Z_][a-zA-Z0-9_]*:[^:]"))) | ||
| 3278 | ;; Skip over comments and labels following openbrace. | ||
| 3279 | (cond ((= (following-char) ?\#) | ||
| 3280 | ;;(forward-line 1) | ||
| 3281 | (end-of-line)) | ||
| 3282 | ;; label: | ||
| 3283 | (t | ||
| 3284 | (save-excursion (end-of-line) | ||
| 3285 | (setq colon-line-end (point))) | ||
| 3286 | (search-forward ":")))) | ||
| 3287 | ;; Now at the point, after label, or at start | ||
| 3288 | ;; of first statement in the block. | ||
| 3289 | (and (< (point) start-point) | ||
| 3290 | (if (> colon-line-end (point)) | ||
| 3291 | ;; Before statement after label | ||
| 3292 | (if (> (current-indentation) | ||
| 3293 | cperl-min-label-indent) | ||
| 3294 | (list (list 'label-in-block (point))) | ||
| 3295 | ;; Do not believe: `max' is involved | ||
| 3296 | (list | ||
| 3297 | (list 'label-in-block-min-indent (point)))) | ||
| 3298 | ;; Before statement | ||
| 3299 | (list 'statement-in-block (point)))))) | ||
| 3300 | ;; If no previous statement, | ||
| 3301 | ;; indent it relative to line brace is on. | ||
| 3302 | ;; For open brace in column zero, don't let statement | ||
| 3303 | ;; start there too. If cperl-indent-level is zero, | ||
| 3304 | ;; use cperl-brace-offset + cperl-continued-statement-offset instead. | ||
| 3305 | ;; For open-braces not the first thing in a line, | ||
| 3306 | ;; add in cperl-brace-imaginary-offset. | ||
| 3307 | |||
| 3308 | ;; If first thing on a line: ????? | ||
| 3309 | (setq unused ; This is not finished... | ||
| 3310 | (+ (if (and (bolp) (zerop cperl-indent-level)) | ||
| 3311 | (+ cperl-brace-offset cperl-continued-statement-offset) | ||
| 3312 | cperl-indent-level) | ||
| 3313 | ;; Move back over whitespace before the openbrace. | ||
| 3314 | ;; If openbrace is not first nonwhite thing on the line, | ||
| 3315 | ;; add the cperl-brace-imaginary-offset. | ||
| 3316 | (progn (skip-chars-backward " \t") | ||
| 3317 | (if (bolp) 0 cperl-brace-imaginary-offset)) | ||
| 3318 | ;; If the openbrace is preceded by a parenthesized exp, | ||
| 3319 | ;; move to the beginning of that; | ||
| 3320 | ;; possibly a different line | ||
| 3321 | (progn | ||
| 3322 | (if (eq (preceding-char) ?\)) | ||
| 3323 | (forward-sexp -1)) | ||
| 3324 | ;; Get initial indentation of the line we are on. | ||
| 3325 | ;; If line starts with label, calculate label indentation | ||
| 3326 | (if (save-excursion | ||
| 3327 | (beginning-of-line) | ||
| 3328 | (looking-at "[ \t]*[a-zA-Z_][a-zA-Z_0-9]*:[^:]")) | ||
| 3329 | (if (> (current-indentation) cperl-min-label-indent) | ||
| 3330 | (- (current-indentation) cperl-label-offset) | ||
| 3331 | (cperl-calculate-indent)) | ||
| 3332 | (current-indentation))))))))) | ||
| 3333 | res))) | ||
| 2878 | 3334 | ||
| 2879 | (defun cperl-calculate-indent-within-comment () | 3335 | (defun cperl-calculate-indent-within-comment () |
| 2880 | "Return the indentation amount for line, assuming that | 3336 | "Return the indentation amount for line, assuming that |
| @@ -2894,14 +3350,22 @@ the current line is to be regarded as part of a block comment." | |||
| 2894 | 3350 | ||
| 2895 | (defun cperl-to-comment-or-eol () | 3351 | (defun cperl-to-comment-or-eol () |
| 2896 | "Go to position before comment on the current line, or to end of line. | 3352 | "Go to position before comment on the current line, or to end of line. |
| 2897 | Returns true if comment is found." | 3353 | Returns true if comment is found. In POD will not move the point." |
| 2898 | (let (state stop-in cpoint (lim (progn (end-of-line) (point)))) | 3354 | ;; If the line is inside other syntax groups (qq-style strings, HERE-docs) |
| 3355 | ;; then looks for literal # or end-of-line. | ||
| 3356 | (let (state stop-in cpoint (lim (progn (end-of-line) (point))) pr e) | ||
| 3357 | (or cperl-font-locking | ||
| 3358 | (cperl-update-syntaxification lim lim)) | ||
| 2899 | (beginning-of-line) | 3359 | (beginning-of-line) |
| 2900 | (if (or | 3360 | (if (setq pr (get-text-property (point) 'syntax-type)) |
| 2901 | (eq (get-text-property (point) 'syntax-type) 'pod) | 3361 | (setq e (next-single-property-change (point) 'syntax-type nil (point-max)))) |
| 2902 | (re-search-forward "\\=[ \t]*\\(#\\|$\\)" lim t)) | 3362 | (if (or (eq pr 'pod) |
| 3363 | (if (or (not e) (> e lim)) ; deep inside a group | ||
| 3364 | (re-search-forward "\\=[ \t]*\\(#\\|$\\)" lim t))) | ||
| 2903 | (if (eq (preceding-char) ?\#) (progn (backward-char 1) t)) | 3365 | (if (eq (preceding-char) ?\#) (progn (backward-char 1) t)) |
| 2904 | ;; Else | 3366 | ;; Else - need to do it the hard way |
| 3367 | (and (and e (<= e lim)) | ||
| 3368 | (goto-char e)) | ||
| 2905 | (while (not stop-in) | 3369 | (while (not stop-in) |
| 2906 | (setq state (parse-partial-sexp (point) lim nil nil nil t)) | 3370 | (setq state (parse-partial-sexp (point) lim nil nil nil t)) |
| 2907 | ; stop at comment | 3371 | ; stop at comment |
| @@ -2933,17 +3397,11 @@ Returns true if comment is found." | |||
| 2933 | (setq stop-in t))) ; Finish | 3397 | (setq stop-in t))) ; Finish |
| 2934 | (nth 4 state)))) | 3398 | (nth 4 state)))) |
| 2935 | 3399 | ||
| 2936 | (defsubst cperl-1- (p) | ||
| 2937 | (max (point-min) (1- p))) | ||
| 2938 | |||
| 2939 | (defsubst cperl-1+ (p) | ||
| 2940 | (min (point-max) (1+ p))) | ||
| 2941 | |||
| 2942 | (defsubst cperl-modify-syntax-type (at how) | 3400 | (defsubst cperl-modify-syntax-type (at how) |
| 2943 | (if (< at (point-max)) | 3401 | (if (< at (point-max)) |
| 2944 | (progn | 3402 | (progn |
| 2945 | (put-text-property at (1+ at) 'syntax-table how) | 3403 | (put-text-property at (1+ at) 'syntax-table how) |
| 2946 | (put-text-property at (1+ at) 'rear-nonsticky t)))) | 3404 | (put-text-property at (1+ at) 'rear-nonsticky '(syntax-table))))) |
| 2947 | 3405 | ||
| 2948 | (defun cperl-protect-defun-start (s e) | 3406 | (defun cperl-protect-defun-start (s e) |
| 2949 | ;; C code looks for "^\\s(" to skip comment backward in "hard" situations | 3407 | ;; C code looks for "^\\s(" to skip comment backward in "hard" situations |
| @@ -2978,35 +3436,53 @@ Returns true if comment is found." | |||
| 2978 | ( ?\{ . ?\} ) | 3436 | ( ?\{ . ?\} ) |
| 2979 | ( ?\< . ?\> ))) | 3437 | ( ?\< . ?\> ))) |
| 2980 | 3438 | ||
| 2981 | (defun cperl-forward-re (lim end is-2arg set-st st-l err-l argument | 3439 | (defun cperl-cached-syntax-table (st) |
| 3440 | "Get a syntax table cached in ST, or create and cache into ST a syntax table. | ||
| 3441 | All the entries of the syntax table are \".\", except for a backslash, which | ||
| 3442 | is quoting." | ||
| 3443 | (if (car-safe st) | ||
| 3444 | (car st) | ||
| 3445 | (setcar st (make-syntax-table)) | ||
| 3446 | (setq st (car st)) | ||
| 3447 | (let ((i 0)) | ||
| 3448 | (while (< i 256) | ||
| 3449 | (modify-syntax-entry i "." st) | ||
| 3450 | (setq i (1+ i)))) | ||
| 3451 | (modify-syntax-entry ?\\ "\\" st) | ||
| 3452 | st)) | ||
| 3453 | |||
| 3454 | (defun cperl-forward-re (lim end is-2arg st-l err-l argument | ||
| 2982 | &optional ostart oend) | 3455 | &optional ostart oend) |
| 2983 | ;; Works *before* syntax recognition is done | 3456 | "Find the end of a regular expression or a stringish construct (q[] etc). |
| 2984 | ;; May modify syntax-type text property if the situation is too hard | 3457 | The point should be before the starting delimiter. |
| 2985 | (let (b starter ender st i i2 go-forward reset-st) | 3458 | |
| 3459 | Goes to LIM if none is found. If IS-2ARG is non-nil, assumes that it | ||
| 3460 | is s/// or tr/// like expression. If END is nil, generates an error | ||
| 3461 | message if needed. If SET-ST is non-nil, will use (or generate) a | ||
| 3462 | cached syntax table in ST-L. If ERR-L is non-nil, will store the | ||
| 3463 | error message in its CAR (unless it already contains some error | ||
| 3464 | message). ARGUMENT should be the name of the construct (used in error | ||
| 3465 | messages). OSTART, OEND may be set in recursive calls when processing | ||
| 3466 | the second argument of 2ARG construct. | ||
| 3467 | |||
| 3468 | Works *before* syntax recognition is done. In IS-2ARG situation may | ||
| 3469 | modify syntax-type text property if the situation is too hard." | ||
| 3470 | (let (b starter ender st i i2 go-forward reset-st set-st) | ||
| 2986 | (skip-chars-forward " \t") | 3471 | (skip-chars-forward " \t") |
| 2987 | ;; ender means matching-char matcher. | 3472 | ;; ender means matching-char matcher. |
| 2988 | (setq b (point) | 3473 | (setq b (point) |
| 2989 | starter (if (eobp) 0 (char-after b)) | 3474 | starter (if (eobp) 0 (char-after b)) |
| 2990 | ender (cdr (assoc starter cperl-starters))) | 3475 | ender (cdr (assoc starter cperl-starters))) |
| 2991 | ;; What if starter == ?\\ ???? | 3476 | ;; What if starter == ?\\ ???? |
| 2992 | (if set-st | 3477 | (setq st (cperl-cached-syntax-table st-l)) |
| 2993 | (if (car st-l) | ||
| 2994 | (setq st (car st-l)) | ||
| 2995 | (setcar st-l (make-syntax-table)) | ||
| 2996 | (setq i 0 st (car st-l)) | ||
| 2997 | (while (< i 256) | ||
| 2998 | (modify-syntax-entry i "." st) | ||
| 2999 | (setq i (1+ i))) | ||
| 3000 | (modify-syntax-entry ?\\ "\\" st))) | ||
| 3001 | (setq set-st t) | 3478 | (setq set-st t) |
| 3002 | ;; Whether we have an intermediate point | 3479 | ;; Whether we have an intermediate point |
| 3003 | (setq i nil) | 3480 | (setq i nil) |
| 3004 | ;; Prepare the syntax table: | 3481 | ;; Prepare the syntax table: |
| 3005 | (and set-st | 3482 | (if (not ender) ; m/blah/, s/x//, s/x/y/ |
| 3006 | (if (not ender) ; m/blah/, s/x//, s/x/y/ | 3483 | (modify-syntax-entry starter "$" st) |
| 3007 | (modify-syntax-entry starter "$" st) | 3484 | (modify-syntax-entry starter (concat "(" (list ender)) st) |
| 3008 | (modify-syntax-entry starter (concat "(" (list ender)) st) | 3485 | (modify-syntax-entry ender (concat ")" (list starter)) st)) |
| 3009 | (modify-syntax-entry ender (concat ")" (list starter)) st))) | ||
| 3010 | (condition-case bb | 3486 | (condition-case bb |
| 3011 | (progn | 3487 | (progn |
| 3012 | ;; We use `$' syntax class to find matching stuff, but $$ | 3488 | ;; We use `$' syntax class to find matching stuff, but $$ |
| @@ -3053,7 +3529,7 @@ Returns true if comment is found." | |||
| 3053 | (modify-syntax-entry starter (if (eq starter ?\\) "\\" ".") st) | 3529 | (modify-syntax-entry starter (if (eq starter ?\\) "\\" ".") st) |
| 3054 | (if ender (modify-syntax-entry ender "." st)) | 3530 | (if ender (modify-syntax-entry ender "." st)) |
| 3055 | (setq set-st nil) | 3531 | (setq set-st nil) |
| 3056 | (setq ender (cperl-forward-re lim end nil t st-l err-l | 3532 | (setq ender (cperl-forward-re lim end nil st-l err-l |
| 3057 | argument starter ender) | 3533 | argument starter ender) |
| 3058 | ender (nth 2 ender))))) | 3534 | ender (nth 2 ender))))) |
| 3059 | (error (goto-char lim) | 3535 | (error (goto-char lim) |
| @@ -3078,6 +3554,33 @@ Returns true if comment is found." | |||
| 3078 | ;; go-forward: has 2 args, and the second part is empty | 3554 | ;; go-forward: has 2 args, and the second part is empty |
| 3079 | (list i i2 ender starter go-forward))) | 3555 | (list i i2 ender starter go-forward))) |
| 3080 | 3556 | ||
| 3557 | (defun cperl-forward-group-in-re (&optional st-l) | ||
| 3558 | "Find the end of a group in a REx. | ||
| 3559 | Return the error message (if any). Does not work if delimiter is `)'. | ||
| 3560 | Works before syntax recognition is done." | ||
| 3561 | ;; Works *before* syntax recognition is done | ||
| 3562 | (or st-l (setq st-l (list nil))) ; Avoid overwriting '() | ||
| 3563 | (let (st b reset-st) | ||
| 3564 | (condition-case b | ||
| 3565 | (progn | ||
| 3566 | (setq st (cperl-cached-syntax-table st-l)) | ||
| 3567 | (modify-syntax-entry ?\( "()" st) | ||
| 3568 | (modify-syntax-entry ?\) ")(" st) | ||
| 3569 | (setq reset-st (syntax-table)) | ||
| 3570 | (set-syntax-table st) | ||
| 3571 | (forward-sexp 1)) | ||
| 3572 | (error (message | ||
| 3573 | "cperl-forward-group-in-re: error %s" b))) | ||
| 3574 | ;; now restore the initial state | ||
| 3575 | (if st | ||
| 3576 | (progn | ||
| 3577 | (modify-syntax-entry ?\( "." st) | ||
| 3578 | (modify-syntax-entry ?\) "." st))) | ||
| 3579 | (if reset-st | ||
| 3580 | (set-syntax-table reset-st)) | ||
| 3581 | b)) | ||
| 3582 | |||
| 3583 | |||
| 3081 | (defvar font-lock-string-face) | 3584 | (defvar font-lock-string-face) |
| 3082 | ;;(defvar font-lock-reference-face) | 3585 | ;;(defvar font-lock-reference-face) |
| 3083 | (defvar font-lock-constant-face) | 3586 | (defvar font-lock-constant-face) |
| @@ -3103,13 +3606,24 @@ Returns true if comment is found." | |||
| 3103 | ;; d) 'Q'uoted string: | 3606 | ;; d) 'Q'uoted string: |
| 3104 | ;; part between markers inclusive is marked `syntax-type' ==> `string' | 3607 | ;; part between markers inclusive is marked `syntax-type' ==> `string' |
| 3105 | ;; part between `q' and the first marker is marked `syntax-type' ==> `prestring' | 3608 | ;; part between `q' and the first marker is marked `syntax-type' ==> `prestring' |
| 3609 | ;; second part of s///e is marked `syntax-type' ==> `multiline' | ||
| 3610 | ;; e) Attributes of subroutines: `attrib-group' ==> t | ||
| 3611 | ;; (or 0 if declaration); up to `{' or ';': `syntax-type' => `sub-decl'. | ||
| 3612 | ;; f) Multiline my/our declaration lists etc: `syntax-type' => `multiline' | ||
| 3613 | |||
| 3614 | ;;; In addition, some parts of RExes may be marked as `REx-interpolated' | ||
| 3615 | ;;; (value: 0 in //o, 1 if "interpolated variable" is whole-REx, t otherwise). | ||
| 3106 | 3616 | ||
| 3107 | (defun cperl-unwind-to-safe (before &optional end) | 3617 | (defun cperl-unwind-to-safe (before &optional end) |
| 3108 | ;; if BEFORE, go to the previous start-of-line on each step of unwinding | 3618 | ;; if BEFORE, go to the previous start-of-line on each step of unwinding |
| 3109 | (let ((pos (point)) opos) | 3619 | (let ((pos (point)) opos) |
| 3110 | (setq opos pos) | 3620 | (while (and pos (progn |
| 3111 | (while (and pos (get-text-property pos 'syntax-type)) | 3621 | (beginning-of-line) |
| 3112 | (setq pos (previous-single-property-change pos 'syntax-type)) | 3622 | (get-text-property (setq pos (point)) 'syntax-type))) |
| 3623 | (setq opos pos | ||
| 3624 | pos (cperl-beginning-of-property pos 'syntax-type)) | ||
| 3625 | (if (eq pos (point-min)) | ||
| 3626 | (setq pos nil)) | ||
| 3113 | (if pos | 3627 | (if pos |
| 3114 | (if before | 3628 | (if before |
| 3115 | (progn | 3629 | (progn |
| @@ -3126,32 +3640,117 @@ Returns true if comment is found." | |||
| 3126 | (setq pos (point)) | 3640 | (setq pos (point)) |
| 3127 | (if end | 3641 | (if end |
| 3128 | ;; Do the same for end, going small steps | 3642 | ;; Do the same for end, going small steps |
| 3129 | (progn | 3643 | (save-excursion |
| 3130 | (while (and end (get-text-property end 'syntax-type)) | 3644 | (while (and end (get-text-property end 'syntax-type)) |
| 3131 | (setq pos end | 3645 | (setq pos end |
| 3132 | end (next-single-property-change end 'syntax-type))) | 3646 | end (next-single-property-change end 'syntax-type nil (point-max))) |
| 3647 | (if end (progn (goto-char end) | ||
| 3648 | (or (bolp) (forward-line 1)) | ||
| 3649 | (setq end (point))))) | ||
| 3133 | (or end pos))))) | 3650 | (or end pos))))) |
| 3134 | 3651 | ||
| 3652 | ;;; These are needed for byte-compile (at least with v19) | ||
| 3135 | (defvar cperl-nonoverridable-face) | 3653 | (defvar cperl-nonoverridable-face) |
| 3654 | (defvar font-lock-variable-name-face) | ||
| 3136 | (defvar font-lock-function-name-face) | 3655 | (defvar font-lock-function-name-face) |
| 3656 | (defvar font-lock-keyword-face) | ||
| 3657 | (defvar font-lock-builtin-face) | ||
| 3658 | (defvar font-lock-type-face) | ||
| 3137 | (defvar font-lock-comment-face) | 3659 | (defvar font-lock-comment-face) |
| 3660 | (defvar font-lock-warning-face) | ||
| 3138 | 3661 | ||
| 3139 | (defun cperl-find-pods-heres (&optional min max non-inter end ignore-max) | 3662 | (defun cperl-find-sub-attrs (&optional st-l b-fname e-fname pos) |
| 3663 | "Syntaxically mark (and fontify) attributes of a subroutine. | ||
| 3664 | Should be called with the point before leading colon of an attribute." | ||
| 3665 | ;; Works *before* syntax recognition is done | ||
| 3666 | (or st-l (setq st-l (list nil))) ; Avoid overwriting '() | ||
| 3667 | (let (st b p reset-st after-first (start (point)) start1 end1) | ||
| 3668 | (condition-case b | ||
| 3669 | (while (looking-at | ||
| 3670 | (concat | ||
| 3671 | "\\(" ; 1=optional? colon | ||
| 3672 | ":" cperl-maybe-white-and-comment-rex ; 2=whitespace/comment? | ||
| 3673 | "\\)" | ||
| 3674 | (if after-first "?" "") | ||
| 3675 | ;; No space between name and paren allowed... | ||
| 3676 | "\\(\\sw+\\)" ; 3=name | ||
| 3677 | "\\((\\)?")) ; 4=optional paren | ||
| 3678 | (and (match-beginning 1) | ||
| 3679 | (cperl-postpone-fontification | ||
| 3680 | (match-beginning 0) (cperl-1+ (match-beginning 0)) | ||
| 3681 | 'face font-lock-constant-face)) | ||
| 3682 | (setq start1 (match-beginning 3) end1 (match-end 3)) | ||
| 3683 | (cperl-postpone-fontification start1 end1 | ||
| 3684 | 'face font-lock-constant-face) | ||
| 3685 | (goto-char end1) ; end or before `(' | ||
| 3686 | (if (match-end 4) ; Have attribute arguments... | ||
| 3687 | (progn | ||
| 3688 | (if st nil | ||
| 3689 | (setq st (cperl-cached-syntax-table st-l)) | ||
| 3690 | (modify-syntax-entry ?\( "()" st) | ||
| 3691 | (modify-syntax-entry ?\) ")(" st)) | ||
| 3692 | (setq reset-st (syntax-table) p (point)) | ||
| 3693 | (set-syntax-table st) | ||
| 3694 | (forward-sexp 1) | ||
| 3695 | (set-syntax-table reset-st) | ||
| 3696 | (setq reset-st nil) | ||
| 3697 | (cperl-commentify p (point) t))) ; mark as string | ||
| 3698 | (forward-comment (buffer-size)) | ||
| 3699 | (setq after-first t)) | ||
| 3700 | (error (message | ||
| 3701 | "L%d: attribute `%s': %s" | ||
| 3702 | (count-lines (point-min) (point)) | ||
| 3703 | (and start1 end1 (buffer-substring start1 end1)) b) | ||
| 3704 | (setq start nil))) | ||
| 3705 | (and start | ||
| 3706 | (progn | ||
| 3707 | (put-text-property start (point) | ||
| 3708 | 'attrib-group (if (looking-at "{") t 0)) | ||
| 3709 | (and pos | ||
| 3710 | (< 1 (count-lines (+ 3 pos) (point))) ; end of `sub' | ||
| 3711 | ;; Apparently, we do not need `multiline': faces added now | ||
| 3712 | (put-text-property (+ 3 pos) (cperl-1+ (point)) | ||
| 3713 | 'syntax-type 'sub-decl)) | ||
| 3714 | (and b-fname ; Fontify here: the following condition | ||
| 3715 | (cperl-postpone-fontification ; is too hard to determine by | ||
| 3716 | b-fname e-fname 'face ; a REx, so do it here | ||
| 3717 | (if (looking-at "{") | ||
| 3718 | font-lock-function-name-face | ||
| 3719 | font-lock-variable-name-face))))) | ||
| 3720 | ;; now restore the initial state | ||
| 3721 | (if st | ||
| 3722 | (progn | ||
| 3723 | (modify-syntax-entry ?\( "." st) | ||
| 3724 | (modify-syntax-entry ?\) "." st))) | ||
| 3725 | (if reset-st | ||
| 3726 | (set-syntax-table reset-st)))) | ||
| 3727 | |||
| 3728 | (defsubst cperl-look-at-leading-count (is-x-REx e) | ||
| 3729 | (if (re-search-forward (concat "\\=" (if is-x-REx "[ \t\n]*" "") "[{?+*]") | ||
| 3730 | (1- e) t) ; return nil on failure, no moving | ||
| 3731 | (if (eq ?\{ (preceding-char)) nil | ||
| 3732 | (cperl-postpone-fontification | ||
| 3733 | (1- (point)) (point) | ||
| 3734 | 'face font-lock-warning-face)))) | ||
| 3735 | |||
| 3736 | ;;; Debugging this may require (setq max-specpdl-size 2000)... | ||
| 3737 | (defun cperl-find-pods-heres (&optional min max non-inter end ignore-max end-of-here-doc) | ||
| 3140 | "Scans the buffer for hard-to-parse Perl constructions. | 3738 | "Scans the buffer for hard-to-parse Perl constructions. |
| 3141 | If `cperl-pod-here-fontify' is not-nil after evaluation, will fontify | 3739 | If `cperl-pod-here-fontify' is not-nil after evaluation, will fontify |
| 3142 | the sections using `cperl-pod-head-face', `cperl-pod-face', | 3740 | the sections using `cperl-pod-head-face', `cperl-pod-face', |
| 3143 | `cperl-here-face'." | 3741 | `cperl-here-face'." |
| 3144 | (interactive) | 3742 | (interactive) |
| 3145 | (or min (setq min (point-min) | 3743 | (or min (setq min (point-min) |
| 3146 | cperl-syntax-state nil | 3744 | cperl-syntax-state nil |
| 3147 | cperl-syntax-done-to min)) | 3745 | cperl-syntax-done-to min)) |
| 3148 | (or max (setq max (point-max))) | 3746 | (or max (setq max (point-max))) |
| 3149 | (let* ((cperl-pod-here-fontify (eval cperl-pod-here-fontify)) go tmpend | 3747 | (let* ((cperl-pod-here-fontify (eval cperl-pod-here-fontify)) go tmpend |
| 3150 | face head-face here-face b e bb tag qtag b1 e1 argument i c tail tb | 3748 | face head-face here-face b e bb tag qtag b1 e1 argument i c tail tb |
| 3151 | is-REx is-x-REx REx-comment-start REx-comment-end was-comment i2 | 3749 | is-REx is-x-REx REx-subgr-start REx-subgr-end was-subgr i2 hairy-RE |
| 3152 | (case-fold-search nil) (inhibit-read-only t) (buffer-undo-list t) | 3750 | (case-fold-search nil) (inhibit-read-only t) (buffer-undo-list t) |
| 3153 | (modified (buffer-modified-p)) | 3751 | (modified (buffer-modified-p)) overshoot is-o-REx |
| 3154 | (after-change-functions nil) | 3752 | (after-change-functions nil) |
| 3753 | (cperl-font-locking t) | ||
| 3155 | (use-syntax-state (and cperl-syntax-state | 3754 | (use-syntax-state (and cperl-syntax-state |
| 3156 | (>= min (car cperl-syntax-state)))) | 3755 | (>= min (car cperl-syntax-state)))) |
| 3157 | (state-point (if use-syntax-state | 3756 | (state-point (if use-syntax-state |
| @@ -3162,33 +3761,62 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', | |||
| 3162 | ;; (st-l '(nil)) (err-l '(nil)) ; Would overwrite - propagates from a function call to a function call! | 3761 | ;; (st-l '(nil)) (err-l '(nil)) ; Would overwrite - propagates from a function call to a function call! |
| 3163 | (st-l (list nil)) (err-l (list nil)) | 3762 | (st-l (list nil)) (err-l (list nil)) |
| 3164 | ;; Somehow font-lock may be not loaded yet... | 3763 | ;; Somehow font-lock may be not loaded yet... |
| 3764 | ;; (e.g., when building TAGS via command-line call) | ||
| 3165 | (font-lock-string-face (if (boundp 'font-lock-string-face) | 3765 | (font-lock-string-face (if (boundp 'font-lock-string-face) |
| 3166 | font-lock-string-face | 3766 | font-lock-string-face |
| 3167 | 'font-lock-string-face)) | 3767 | 'font-lock-string-face)) |
| 3168 | (font-lock-constant-face (if (boundp 'font-lock-constant-face) | 3768 | (my-cperl-delimiters-face (if (boundp 'font-lock-constant-face) |
| 3169 | font-lock-constant-face | 3769 | font-lock-constant-face |
| 3170 | 'font-lock-constant-face)) | 3770 | 'font-lock-constant-face)) |
| 3171 | (font-lock-function-name-face | 3771 | (my-cperl-REx-spec-char-face ; [] ^.$ and wrapper-of ({}) |
| 3172 | (if (boundp 'font-lock-function-name-face) | 3772 | (if (boundp 'font-lock-function-name-face) |
| 3173 | font-lock-function-name-face | 3773 | font-lock-function-name-face |
| 3174 | 'font-lock-function-name-face)) | 3774 | 'font-lock-function-name-face)) |
| 3775 | (font-lock-variable-name-face ; interpolated vars and ({})-code | ||
| 3776 | (if (boundp 'font-lock-variable-name-face) | ||
| 3777 | font-lock-variable-name-face | ||
| 3778 | 'font-lock-variable-name-face)) | ||
| 3779 | (font-lock-function-name-face ; used in `cperl-find-sub-attrs' | ||
| 3780 | (if (boundp 'font-lock-function-name-face) | ||
| 3781 | font-lock-function-name-face | ||
| 3782 | 'font-lock-function-name-face)) | ||
| 3783 | (font-lock-constant-face ; used in `cperl-find-sub-attrs' | ||
| 3784 | (if (boundp 'font-lock-constant-face) | ||
| 3785 | font-lock-constant-face | ||
| 3786 | 'font-lock-constant-face)) | ||
| 3787 | (my-cperl-REx-0length-face ; 0-length, (?:)etc, non-literal \ | ||
| 3788 | (if (boundp 'font-lock-builtin-face) | ||
| 3789 | font-lock-builtin-face | ||
| 3790 | 'font-lock-builtin-face)) | ||
| 3175 | (font-lock-comment-face | 3791 | (font-lock-comment-face |
| 3176 | (if (boundp 'font-lock-comment-face) | 3792 | (if (boundp 'font-lock-comment-face) |
| 3177 | font-lock-comment-face | 3793 | font-lock-comment-face |
| 3178 | 'font-lock-comment-face)) | 3794 | 'font-lock-comment-face)) |
| 3179 | (cperl-nonoverridable-face | 3795 | (font-lock-warning-face |
| 3796 | (if (boundp 'font-lock-warning-face) | ||
| 3797 | font-lock-warning-face | ||
| 3798 | 'font-lock-warning-face)) | ||
| 3799 | (my-cperl-REx-ctl-face ; (|) | ||
| 3800 | (if (boundp 'font-lock-keyword-face) | ||
| 3801 | font-lock-keyword-face | ||
| 3802 | 'font-lock-keyword-face)) | ||
| 3803 | (my-cperl-REx-modifiers-face ; //gims | ||
| 3180 | (if (boundp 'cperl-nonoverridable-face) | 3804 | (if (boundp 'cperl-nonoverridable-face) |
| 3181 | cperl-nonoverridable-face | 3805 | cperl-nonoverridable-face |
| 3182 | 'cperl-nonoverridable)) | 3806 | 'cperl-nonoverridable-face)) |
| 3807 | (my-cperl-REx-length1-face ; length=1 escaped chars, POSIX classes | ||
| 3808 | (if (boundp 'font-lock-type-face) | ||
| 3809 | font-lock-type-face | ||
| 3810 | 'font-lock-type-face)) | ||
| 3183 | (stop-point (if ignore-max | 3811 | (stop-point (if ignore-max |
| 3184 | (point-max) | 3812 | (point-max) |
| 3185 | max)) | 3813 | max)) |
| 3186 | (search | 3814 | (search |
| 3187 | (concat | 3815 | (concat |
| 3188 | "\\(\\`\n?\\|^\n\\)=" | 3816 | "\\(\\`\n?\\|^\n\\)=" ; POD |
| 3189 | "\\|" | 3817 | "\\|" |
| 3190 | ;; One extra () before this: | 3818 | ;; One extra () before this: |
| 3191 | "<<" | 3819 | "<<" ; HERE-DOC |
| 3192 | "\\(" ; 1 + 1 | 3820 | "\\(" ; 1 + 1 |
| 3193 | ;; First variant "BLAH" or just ``. | 3821 | ;; First variant "BLAH" or just ``. |
| 3194 | "[ \t]*" ; Yes, whitespace is allowed! | 3822 | "[ \t]*" ; Yes, whitespace is allowed! |
| @@ -3204,36 +3832,44 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', | |||
| 3204 | "\\)" | 3832 | "\\)" |
| 3205 | "\\|" | 3833 | "\\|" |
| 3206 | ;; 1+6 extra () before this: | 3834 | ;; 1+6 extra () before this: |
| 3207 | "^[ \t]*\\(format\\)[ \t]*\\([a-zA-Z0-9_]+\\)?[ \t]*=[ \t]*$" | 3835 | "^[ \t]*\\(format\\)[ \t]*\\([a-zA-Z0-9_]+\\)?[ \t]*=[ \t]*$" ;FRMAT |
| 3208 | (if cperl-use-syntax-table-text-property | 3836 | (if cperl-use-syntax-table-text-property |
| 3209 | (concat | 3837 | (concat |
| 3210 | "\\|" | 3838 | "\\|" |
| 3211 | ;; 1+6+2=9 extra () before this: | 3839 | ;; 1+6+2=9 extra () before this: |
| 3212 | "\\<\\(q[wxqr]?\\|[msy]\\|tr\\)\\>" | 3840 | "\\<\\(q[wxqr]?\\|[msy]\\|tr\\)\\>" ; QUOTED CONSTRUCT |
| 3213 | "\\|" | 3841 | "\\|" |
| 3214 | ;; 1+6+2+1=10 extra () before this: | 3842 | ;; 1+6+2+1=10 extra () before this: |
| 3215 | "\\([?/<]\\)" ; /blah/ or ?blah? or <file*glob> | 3843 | "\\([?/<]\\)" ; /blah/ or ?blah? or <file*glob> |
| 3216 | "\\|" | 3844 | "\\|" |
| 3217 | ;; 1+6+2+1+1=11 extra () before this: | 3845 | ;; 1+6+2+1+1=11 extra () before this |
| 3218 | "\\<sub\\>[ \t]*\\([a-zA-Z_:'0-9]+[ \t]*\\)?\\(([^()]*)\\)" | 3846 | "\\<sub\\>" ; sub with proto/attr |
| 3847 | "\\(" | ||
| 3848 | cperl-white-and-comment-rex | ||
| 3849 | "\\(::[a-zA-Z_:'0-9]*\\|[a-zA-Z_'][a-zA-Z_:'0-9]*\\)\\)?" ; name | ||
| 3850 | "\\(" | ||
| 3851 | cperl-maybe-white-and-comment-rex | ||
| 3852 | "\\(([^()]*)\\|:[^:]\\)\\)" ; prototype or attribute start | ||
| 3219 | "\\|" | 3853 | "\\|" |
| 3220 | ;; 1+6+2+1+1+2=13 extra () before this: | 3854 | ;; 1+6+2+1+1+6=17 extra () before this: |
| 3221 | "\\$\\(['{]\\)" | 3855 | "\\$\\(['{]\\)" ; $' or ${foo} |
| 3222 | "\\|" | 3856 | "\\|" |
| 3223 | ;; 1+6+2+1+1+2+1=14 extra () before this: | 3857 | ;; 1+6+2+1+1+6+1=18 extra () before this (old pack'var syntax; |
| 3858 | ;; we do not support intervening comments...): | ||
| 3224 | "\\(\\<sub[ \t\n\f]+\\|[&*$@%]\\)[a-zA-Z0-9_]*'" | 3859 | "\\(\\<sub[ \t\n\f]+\\|[&*$@%]\\)[a-zA-Z0-9_]*'" |
| 3225 | ;; 1+6+2+1+1+2+1+1=15 extra () before this: | 3860 | ;; 1+6+2+1+1+6+1+1=19 extra () before this: |
| 3226 | "\\|" | 3861 | "\\|" |
| 3227 | "__\\(END\\|DATA\\)__" | 3862 | "__\\(END\\|DATA\\)__" ; __END__ or __DATA__ |
| 3228 | ;; 1+6+2+1+1+2+1+1+1=16 extra () before this: | 3863 | ;; 1+6+2+1+1+6+1+1+1=20 extra () before this: |
| 3229 | "\\|" | 3864 | "\\|" |
| 3230 | "\\\\\\(['`\"($]\\)") | 3865 | "\\\\\\(['`\"($]\\)") ; BACKWACKED something-hairy |
| 3231 | "")))) | 3866 | "")))) |
| 3232 | (unwind-protect | 3867 | (unwind-protect |
| 3233 | (progn | 3868 | (progn |
| 3234 | (save-excursion | 3869 | (save-excursion |
| 3235 | (or non-inter | 3870 | (or non-inter |
| 3236 | (message "Scanning for \"hard\" Perl constructions...")) | 3871 | (message "Scanning for \"hard\" Perl constructions...")) |
| 3872 | ;;(message "find: %s --> %s" min max) | ||
| 3237 | (and cperl-pod-here-fontify | 3873 | (and cperl-pod-here-fontify |
| 3238 | ;; We had evals here, do not know why... | 3874 | ;; We had evals here, do not know why... |
| 3239 | (setq face cperl-pod-face | 3875 | (setq face cperl-pod-face |
| @@ -3241,16 +3877,22 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', | |||
| 3241 | here-face cperl-here-face)) | 3877 | here-face cperl-here-face)) |
| 3242 | (remove-text-properties min max | 3878 | (remove-text-properties min max |
| 3243 | '(syntax-type t in-pod t syntax-table t | 3879 | '(syntax-type t in-pod t syntax-table t |
| 3880 | attrib-group t | ||
| 3881 | REx-interpolated t | ||
| 3244 | cperl-postpone t | 3882 | cperl-postpone t |
| 3245 | syntax-subtype t | 3883 | syntax-subtype t |
| 3246 | rear-nonsticky t | 3884 | rear-nonsticky t |
| 3885 | front-sticky t | ||
| 3247 | here-doc-group t | 3886 | here-doc-group t |
| 3248 | first-format-line t | 3887 | first-format-line t |
| 3888 | REx-part2 t | ||
| 3249 | indentable t)) | 3889 | indentable t)) |
| 3250 | ;; Need to remove face as well... | 3890 | ;; Need to remove face as well... |
| 3251 | (goto-char min) | 3891 | (goto-char min) |
| 3252 | (and (eq system-type 'emx) | 3892 | (and (eq system-type 'emx) |
| 3253 | (looking-at "extproc[ \t]") ; Analogue of #! | 3893 | (eq (point) 1) |
| 3894 | (let ((case-fold-search t)) | ||
| 3895 | (looking-at "extproc[ \t]")) ; Analogue of #! | ||
| 3254 | (cperl-commentify min | 3896 | (cperl-commentify min |
| 3255 | (save-excursion (end-of-line) (point)) | 3897 | (save-excursion (end-of-line) (point)) |
| 3256 | nil)) | 3898 | nil)) |
| @@ -3258,11 +3900,38 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', | |||
| 3258 | (< (point) max) | 3900 | (< (point) max) |
| 3259 | (re-search-forward search max t)) | 3901 | (re-search-forward search max t)) |
| 3260 | (setq tmpend nil) ; Valid for most cases | 3902 | (setq tmpend nil) ; Valid for most cases |
| 3903 | (setq b (match-beginning 0) | ||
| 3904 | state (save-excursion (parse-partial-sexp | ||
| 3905 | state-point b nil nil state)) | ||
| 3906 | state-point b) | ||
| 3261 | (cond | 3907 | (cond |
| 3908 | ;; 1+6+2+1+1+6=17 extra () before this: | ||
| 3909 | ;; "\\$\\(['{]\\)" | ||
| 3910 | ((match-beginning 18) ; $' or ${foo} | ||
| 3911 | (if (eq (preceding-char) ?\') ; $' | ||
| 3912 | (progn | ||
| 3913 | (setq b (1- (point)) | ||
| 3914 | state (parse-partial-sexp | ||
| 3915 | state-point (1- b) nil nil state) | ||
| 3916 | state-point (1- b)) | ||
| 3917 | (if (nth 3 state) ; in string | ||
| 3918 | (cperl-modify-syntax-type (1- b) cperl-st-punct)) | ||
| 3919 | (goto-char (1+ b))) | ||
| 3920 | ;; else: ${ | ||
| 3921 | (setq bb (match-beginning 0)) | ||
| 3922 | (cperl-modify-syntax-type bb cperl-st-punct))) | ||
| 3923 | ;; No processing in strings/comments beyond this point: | ||
| 3924 | ((or (nth 3 state) (nth 4 state)) | ||
| 3925 | t) ; Do nothing in comment/string | ||
| 3262 | ((match-beginning 1) ; POD section | 3926 | ((match-beginning 1) ; POD section |
| 3263 | ;; "\\(\\`\n?\\|^\n\\)=" | 3927 | ;; "\\(\\`\n?\\|^\n\\)=" |
| 3264 | (if (looking-at "cut\\>") | 3928 | (setq b (match-beginning 0) |
| 3265 | (if ignore-max | 3929 | state (parse-partial-sexp |
| 3930 | state-point b nil nil state) | ||
| 3931 | state-point b) | ||
| 3932 | (if (or (nth 3 state) (nth 4 state) | ||
| 3933 | (looking-at "cut\\>")) | ||
| 3934 | (if (or (nth 3 state) (nth 4 state) ignore-max) | ||
| 3266 | nil ; Doing a chunk only | 3935 | nil ; Doing a chunk only |
| 3267 | (message "=cut is not preceded by a POD section") | 3936 | (message "=cut is not preceded by a POD section") |
| 3268 | (or (car err-l) (setcar err-l (point)))) | 3937 | (or (car err-l) (setcar err-l (point)))) |
| @@ -3288,11 +3957,15 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', | |||
| 3288 | (progn | 3957 | (progn |
| 3289 | (remove-text-properties | 3958 | (remove-text-properties |
| 3290 | max e '(syntax-type t in-pod t syntax-table t | 3959 | max e '(syntax-type t in-pod t syntax-table t |
| 3960 | attrib-group t | ||
| 3961 | REx-interpolated t | ||
| 3291 | cperl-postpone t | 3962 | cperl-postpone t |
| 3292 | syntax-subtype t | 3963 | syntax-subtype t |
| 3293 | here-doc-group t | 3964 | here-doc-group t |
| 3294 | rear-nonsticky t | 3965 | rear-nonsticky t |
| 3966 | front-sticky t | ||
| 3295 | first-format-line t | 3967 | first-format-line t |
| 3968 | REx-part2 t | ||
| 3296 | indentable t)) | 3969 | indentable t)) |
| 3297 | (setq tmpend tb))) | 3970 | (setq tmpend tb))) |
| 3298 | (put-text-property b e 'in-pod t) | 3971 | (put-text-property b e 'in-pod t) |
| @@ -3335,7 +4008,8 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', | |||
| 3335 | (or (eq e (point-max)) | 4008 | (or (eq e (point-max)) |
| 3336 | (forward-char -1)))) ; Prepare for immediate POD start. | 4009 | (forward-char -1)))) ; Prepare for immediate POD start. |
| 3337 | ;; Here document | 4010 | ;; Here document |
| 3338 | ;; We do only one here-per-line | 4011 | ;; We can do many here-per-line; |
| 4012 | ;; but multiline quote on the same line as <<HERE confuses us... | ||
| 3339 | ;; ;; One extra () before this: | 4013 | ;; ;; One extra () before this: |
| 3340 | ;;"<<" | 4014 | ;;"<<" |
| 3341 | ;; "\\(" ; 1 + 1 | 4015 | ;; "\\(" ; 1 + 1 |
| @@ -3352,21 +4026,42 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', | |||
| 3352 | ;; "\\(\\)" ; To preserve count of pars :-( 6 + 1 | 4026 | ;; "\\(\\)" ; To preserve count of pars :-( 6 + 1 |
| 3353 | ;; "\\)" | 4027 | ;; "\\)" |
| 3354 | ((match-beginning 2) ; 1 + 1 | 4028 | ((match-beginning 2) ; 1 + 1 |
| 3355 | ;; Abort in comment: | 4029 | (setq b (point) |
| 3356 | (setq b (point)) | ||
| 3357 | (setq state (parse-partial-sexp state-point b nil nil state) | ||
| 3358 | state-point b | ||
| 3359 | tb (match-beginning 0) | 4030 | tb (match-beginning 0) |
| 3360 | i (or (nth 3 state) (nth 4 state))) | 4031 | c (and ; not HERE-DOC |
| 3361 | (if i | 4032 | (match-beginning 5) |
| 3362 | (setq c t) | 4033 | (save-match-data |
| 3363 | (setq c (and | 4034 | (or (looking-at "[ \t]*(") ; << function_call() |
| 3364 | (match-beginning 5) | 4035 | (save-excursion ; 1 << func_name, or $foo << 10 |
| 3365 | (not (match-beginning 6)) ; Empty | 4036 | (condition-case nil |
| 3366 | (looking-at | 4037 | (progn |
| 3367 | "[ \t]*[=0-9$@%&(]")))) | 4038 | (goto-char tb) |
| 4039 | ;;; XXX What to do: foo <<bar ??? | ||
| 4040 | ;;; XXX Need to support print {a} <<B ??? | ||
| 4041 | (forward-sexp -1) | ||
| 4042 | (save-match-data | ||
| 4043 | ; $foo << b; $f .= <<B; | ||
| 4044 | ; ($f+1) << b; a($f) . <<B; | ||
| 4045 | ; foo 1, <<B; $x{a} <<b; | ||
| 4046 | (cond | ||
| 4047 | ((looking-at "[0-9$({]") | ||
| 4048 | (forward-sexp 1) | ||
| 4049 | (and | ||
| 4050 | (looking-at "[ \t]*<<") | ||
| 4051 | (condition-case nil | ||
| 4052 | ;; print $foo <<EOF | ||
| 4053 | (progn | ||
| 4054 | (forward-sexp -2) | ||
| 4055 | (not | ||
| 4056 | (looking-at "\\(printf?\\|system\\|exec\\|sort\\)\\>"))) | ||
| 4057 | (error t))))))) | ||
| 4058 | (error nil))) ; func(<<EOF) | ||
| 4059 | (and (not (match-beginning 6)) ; Empty | ||
| 4060 | (looking-at | ||
| 4061 | "[ \t]*[=0-9$@%&(]")))))) | ||
| 3368 | (if c ; Not here-doc | 4062 | (if c ; Not here-doc |
| 3369 | nil ; Skip it. | 4063 | nil ; Skip it. |
| 4064 | (setq c (match-end 2)) ; 1 + 1 | ||
| 3370 | (if (match-beginning 5) ;4 + 1 | 4065 | (if (match-beginning 5) ;4 + 1 |
| 3371 | (setq b1 (match-beginning 5) ; 4 + 1 | 4066 | (setq b1 (match-beginning 5) ; 4 + 1 |
| 3372 | e1 (match-end 5)) ; 4 + 1 | 4067 | e1 (match-end 5)) ; 4 + 1 |
| @@ -3376,15 +4071,20 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', | |||
| 3376 | qtag (regexp-quote tag)) | 4071 | qtag (regexp-quote tag)) |
| 3377 | (cond (cperl-pod-here-fontify | 4072 | (cond (cperl-pod-here-fontify |
| 3378 | ;; Highlight the starting delimiter | 4073 | ;; Highlight the starting delimiter |
| 3379 | (cperl-postpone-fontification b1 e1 'face font-lock-constant-face) | 4074 | (cperl-postpone-fontification |
| 4075 | b1 e1 'face my-cperl-delimiters-face) | ||
| 3380 | (cperl-put-do-not-fontify b1 e1 t))) | 4076 | (cperl-put-do-not-fontify b1 e1 t))) |
| 3381 | (forward-line) | 4077 | (forward-line) |
| 4078 | (setq i (point)) | ||
| 4079 | (if end-of-here-doc | ||
| 4080 | (goto-char end-of-here-doc)) | ||
| 3382 | (setq b (point)) | 4081 | (setq b (point)) |
| 3383 | ;; We do not search to max, since we may be called from | 4082 | ;; We do not search to max, since we may be called from |
| 3384 | ;; some hook of fontification, and max is random | 4083 | ;; some hook of fontification, and max is random |
| 3385 | (or (and (re-search-forward (concat "^" qtag "$") | 4084 | (or (and (re-search-forward (concat "^" qtag "$") |
| 3386 | stop-point 'toend) | 4085 | stop-point 'toend) |
| 3387 | (eq (following-char) ?\n)) | 4086 | ;;;(eq (following-char) ?\n) ; XXXX WHY??? |
| 4087 | ) | ||
| 3388 | (progn ; Pretend we matched at the end | 4088 | (progn ; Pretend we matched at the end |
| 3389 | (goto-char (point-max)) | 4089 | (goto-char (point-max)) |
| 3390 | (re-search-forward "\\'") | 4090 | (re-search-forward "\\'") |
| @@ -3393,8 +4093,9 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', | |||
| 3393 | (if cperl-pod-here-fontify | 4093 | (if cperl-pod-here-fontify |
| 3394 | (progn | 4094 | (progn |
| 3395 | ;; Highlight the ending delimiter | 4095 | ;; Highlight the ending delimiter |
| 3396 | (cperl-postpone-fontification (match-beginning 0) (match-end 0) | 4096 | (cperl-postpone-fontification |
| 3397 | 'face font-lock-constant-face) | 4097 | (match-beginning 0) (match-end 0) |
| 4098 | 'face my-cperl-delimiters-face) | ||
| 3398 | (cperl-put-do-not-fontify b (match-end 0) t) | 4099 | (cperl-put-do-not-fontify b (match-end 0) t) |
| 3399 | ;; Highlight the HERE-DOC | 4100 | ;; Highlight the HERE-DOC |
| 3400 | (cperl-postpone-fontification b (match-beginning 0) | 4101 | (cperl-postpone-fontification b (match-beginning 0) |
| @@ -3404,10 +4105,21 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', | |||
| 3404 | 'syntax-type 'here-doc) | 4105 | 'syntax-type 'here-doc) |
| 3405 | (put-text-property (match-beginning 0) e1 | 4106 | (put-text-property (match-beginning 0) e1 |
| 3406 | 'syntax-type 'here-doc-delim) | 4107 | 'syntax-type 'here-doc-delim) |
| 3407 | (put-text-property b e1 | 4108 | (put-text-property b e1 'here-doc-group t) |
| 3408 | 'here-doc-group t) | 4109 | ;; This makes insertion at the start of HERE-DOC update |
| 4110 | ;; the whole construct: | ||
| 4111 | (put-text-property b (cperl-1+ b) 'front-sticky '(syntax-type)) | ||
| 3409 | (cperl-commentify b e1 nil) | 4112 | (cperl-commentify b e1 nil) |
| 3410 | (cperl-put-do-not-fontify b (match-end 0) t) | 4113 | (cperl-put-do-not-fontify b (match-end 0) t) |
| 4114 | ;; Cache the syntax info... | ||
| 4115 | (setq cperl-syntax-state (cons state-point state)) | ||
| 4116 | ;; ... and process the rest of the line... | ||
| 4117 | (setq overshoot | ||
| 4118 | (elt ; non-inter ignore-max | ||
| 4119 | (cperl-find-pods-heres c i t end t e1) 1)) | ||
| 4120 | (if (and overshoot (> overshoot (point))) | ||
| 4121 | (goto-char overshoot) | ||
| 4122 | (setq overshoot e1)) | ||
| 3411 | (if (> e1 max) | 4123 | (if (> e1 max) |
| 3412 | (setq tmpend tb)))) | 4124 | (setq tmpend tb)))) |
| 3413 | ;; format | 4125 | ;; format |
| @@ -3462,7 +4174,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', | |||
| 3462 | (if (> (point) max) | 4174 | (if (> (point) max) |
| 3463 | (setq tmpend tb)) | 4175 | (setq tmpend tb)) |
| 3464 | (put-text-property b (point) 'syntax-type 'format)) | 4176 | (put-text-property b (point) 'syntax-type 'format)) |
| 3465 | ;; Regexp: | 4177 | ;; qq-like String or Regexp: |
| 3466 | ((or (match-beginning 10) (match-beginning 11)) | 4178 | ((or (match-beginning 10) (match-beginning 11)) |
| 3467 | ;; 1+6+2=9 extra () before this: | 4179 | ;; 1+6+2=9 extra () before this: |
| 3468 | ;; "\\<\\(q[wxqr]?\\|[msy]\\|tr\\)\\>" | 4180 | ;; "\\<\\(q[wxqr]?\\|[msy]\\|tr\\)\\>" |
| @@ -3471,10 +4183,10 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', | |||
| 3471 | (setq b1 (if (match-beginning 10) 10 11) | 4183 | (setq b1 (if (match-beginning 10) 10 11) |
| 3472 | argument (buffer-substring | 4184 | argument (buffer-substring |
| 3473 | (match-beginning b1) (match-end b1)) | 4185 | (match-beginning b1) (match-end b1)) |
| 3474 | b (point) | 4186 | b (point) ; end of qq etc |
| 3475 | i b | 4187 | i b |
| 3476 | c (char-after (match-beginning b1)) | 4188 | c (char-after (match-beginning b1)) |
| 3477 | bb (char-after (1- (match-beginning b1))) ; tmp holder | 4189 | bb (char-after (1- (match-beginning b1))) ; tmp holder |
| 3478 | ;; bb == "Not a stringy" | 4190 | ;; bb == "Not a stringy" |
| 3479 | bb (if (eq b1 10) ; user variables/whatever | 4191 | bb (if (eq b1 10) ; user variables/whatever |
| 3480 | (and (memq bb (append "$@%*#_:-&>" nil)) ; $#y) | 4192 | (and (memq bb (append "$@%*#_:-&>" nil)) ; $#y) |
| @@ -3488,7 +4200,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', | |||
| 3488 | (- (match-beginning b1) 2)) | 4200 | (- (match-beginning b1) 2)) |
| 3489 | ?\-)) | 4201 | ?\-)) |
| 3490 | ((eq bb ?\&) | 4202 | ((eq bb ?\&) |
| 3491 | (not (eq (char-after ; &&m/blah/ | 4203 | (not (eq (char-after ; &&m/blah/ |
| 3492 | (- (match-beginning b1) 2)) | 4204 | (- (match-beginning b1) 2)) |
| 3493 | ?\&))) | 4205 | ?\&))) |
| 3494 | (t t))) | 4206 | (t t))) |
| @@ -3506,41 +4218,40 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', | |||
| 3506 | (setq argument "" | 4218 | (setq argument "" |
| 3507 | b1 nil | 4219 | b1 nil |
| 3508 | bb ; Not a regexp? | 4220 | bb ; Not a regexp? |
| 3509 | (progn | 4221 | (not |
| 3510 | (not | 4222 | ;; What is below: regexp-p? |
| 3511 | ;; What is below: regexp-p? | 4223 | (and |
| 3512 | (and | 4224 | (or (memq (preceding-char) |
| 3513 | (or (memq (preceding-char) | 4225 | (append (if (memq c '(?\? ?\<)) |
| 3514 | (append (if (memq c '(?\? ?\<)) | 4226 | ;; $a++ ? 1 : 2 |
| 3515 | ;; $a++ ? 1 : 2 | 4227 | "~{(=|&*!,;:[" |
| 3516 | "~{(=|&*!,;:" | 4228 | "~{(=|&+-*!,;:[") nil)) |
| 3517 | "~{(=|&+-*!,;:") nil)) | 4229 | (and (eq (preceding-char) ?\}) |
| 3518 | (and (eq (preceding-char) ?\}) | 4230 | (cperl-after-block-p (point-min))) |
| 3519 | (cperl-after-block-p (point-min))) | 4231 | (and (eq (char-syntax (preceding-char)) ?w) |
| 3520 | (and (eq (char-syntax (preceding-char)) ?w) | 4232 | (progn |
| 3521 | (progn | 4233 | (forward-sexp -1) |
| 3522 | (forward-sexp -1) | ||
| 3523 | ;; After these keywords `/' starts a RE. One should add all the | 4234 | ;; After these keywords `/' starts a RE. One should add all the |
| 3524 | ;; functions/builtins which expect an argument, but ... | 4235 | ;; functions/builtins which expect an argument, but ... |
| 3525 | (if (eq (preceding-char) ?-) | 4236 | (if (eq (preceding-char) ?-) |
| 3526 | ;; -d ?foo? is a RE | 4237 | ;; -d ?foo? is a RE |
| 3527 | (looking-at "[a-zA-Z]\\>") | 4238 | (looking-at "[a-zA-Z]\\>") |
| 3528 | (and | 4239 | (and |
| 3529 | (not (memq (preceding-char) | 4240 | (not (memq (preceding-char) |
| 3530 | '(?$ ?@ ?& ?%))) | 4241 | '(?$ ?@ ?& ?%))) |
| 3531 | (looking-at | 4242 | (looking-at |
| 3532 | "\\(while\\|if\\|unless\\|until\\|and\\|or\\|not\\|xor\\|split\\|grep\\|map\\|print\\)\\>"))))) | 4243 | "\\(while\\|if\\|unless\\|until\\|and\\|or\\|not\\|xor\\|split\\|grep\\|map\\|print\\)\\>"))))) |
| 3533 | (and (eq (preceding-char) ?.) | 4244 | (and (eq (preceding-char) ?.) |
| 3534 | (eq (char-after (- (point) 2)) ?.)) | 4245 | (eq (char-after (- (point) 2)) ?.)) |
| 3535 | (bobp)) | 4246 | (bobp)) |
| 3536 | ;; m|blah| ? foo : bar; | 4247 | ;; m|blah| ? foo : bar; |
| 3537 | (not | 4248 | (not |
| 3538 | (and (eq c ?\?) | 4249 | (and (eq c ?\?) |
| 3539 | cperl-use-syntax-table-text-property | 4250 | cperl-use-syntax-table-text-property |
| 3540 | (not (bobp)) | 4251 | (not (bobp)) |
| 3541 | (progn | 4252 | (progn |
| 3542 | (forward-char -1) | 4253 | (forward-char -1) |
| 3543 | (looking-at "\\s|"))))))) | 4254 | (looking-at "\\s|")))))) |
| 3544 | b (1- b)) | 4255 | b (1- b)) |
| 3545 | ;; s y tr m | 4256 | ;; s y tr m |
| 3546 | ;; Check for $a -> y | 4257 | ;; Check for $a -> y |
| @@ -3550,13 +4261,9 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', | |||
| 3550 | (eq (char-after (- go 2)) ?-)) | 4261 | (eq (char-after (- go 2)) ?-)) |
| 3551 | ;; Not a regexp | 4262 | ;; Not a regexp |
| 3552 | (setq bb t)))) | 4263 | (setq bb t)))) |
| 3553 | (or bb (setq state (parse-partial-sexp | ||
| 3554 | state-point b nil nil state) | ||
| 3555 | state-point b)) | ||
| 3556 | (setq bb (or bb (nth 3 state) (nth 4 state))) | ||
| 3557 | (goto-char b) | ||
| 3558 | (or bb | 4264 | (or bb |
| 3559 | (progn | 4265 | (progn |
| 4266 | (goto-char b) | ||
| 3560 | (if (looking-at "[ \t\n\f]+\\(#[^\n]*\n[ \t\n\f]*\\)+") | 4267 | (if (looking-at "[ \t\n\f]+\\(#[^\n]*\n[ \t\n\f]*\\)+") |
| 3561 | (goto-char (match-end 0)) | 4268 | (goto-char (match-end 0)) |
| 3562 | (skip-chars-forward " \t\n\f")) | 4269 | (skip-chars-forward " \t\n\f")) |
| @@ -3593,6 +4300,8 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', | |||
| 3593 | (skip-chars-backward " \t\n\f") | 4300 | (skip-chars-backward " \t\n\f") |
| 3594 | (memq (preceding-char) | 4301 | (memq (preceding-char) |
| 3595 | (append "$@%&*" nil)))) | 4302 | (append "$@%&*" nil)))) |
| 4303 | (setq bb t)) | ||
| 4304 | ((eobp) | ||
| 3596 | (setq bb t))))) | 4305 | (setq bb t))))) |
| 3597 | (if bb | 4306 | (if bb |
| 3598 | (goto-char i) | 4307 | (goto-char i) |
| @@ -3605,15 +4314,16 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', | |||
| 3605 | ;; qtag means two-arg matcher, may be reset to | 4314 | ;; qtag means two-arg matcher, may be reset to |
| 3606 | ;; 2 or 3 later if some special quoting is needed. | 4315 | ;; 2 or 3 later if some special quoting is needed. |
| 3607 | ;; e1 means matching-char matcher. | 4316 | ;; e1 means matching-char matcher. |
| 3608 | (setq b (point) | 4317 | (setq b (point) ; before the first delimiter |
| 3609 | ;; has 2 args | 4318 | ;; has 2 args |
| 3610 | i2 (string-match "^\\([sy]\\|tr\\)$" argument) | 4319 | i2 (string-match "^\\([sy]\\|tr\\)$" argument) |
| 3611 | ;; We do not search to max, since we may be called from | 4320 | ;; We do not search to max, since we may be called from |
| 3612 | ;; some hook of fontification, and max is random | 4321 | ;; some hook of fontification, and max is random |
| 3613 | i (cperl-forward-re stop-point end | 4322 | i (cperl-forward-re stop-point end |
| 3614 | i2 | 4323 | i2 |
| 3615 | t st-l err-l argument) | 4324 | st-l err-l argument) |
| 3616 | ;; Note that if `go', then it is considered as 1-arg | 4325 | ;; If `go', then it is considered as 1-arg, `b1' is nil |
| 4326 | ;; as in s/foo//x; the point is before final "slash" | ||
| 3617 | b1 (nth 1 i) ; start of the second part | 4327 | b1 (nth 1 i) ; start of the second part |
| 3618 | tag (nth 2 i) ; ender-char, true if second part | 4328 | tag (nth 2 i) ; ender-char, true if second part |
| 3619 | ; is with matching chars [] | 4329 | ; is with matching chars [] |
| @@ -3625,13 +4335,18 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', | |||
| 3625 | (1- e1)) | 4335 | (1- e1)) |
| 3626 | e (if i i e1) ; end of the first part | 4336 | e (if i i e1) ; end of the first part |
| 3627 | qtag nil ; need to preserve backslashitis | 4337 | qtag nil ; need to preserve backslashitis |
| 3628 | is-x-REx nil) ; REx has //x modifier | 4338 | is-x-REx nil is-o-REx nil); REx has //x //o modifiers |
| 4339 | ;; If s{} (), then b/b1 are at "{", "(", e1/i after ")", "}" | ||
| 3629 | ;; Commenting \\ is dangerous, what about ( ? | 4340 | ;; Commenting \\ is dangerous, what about ( ? |
| 3630 | (and i tail | 4341 | (and i tail |
| 3631 | (eq (char-after i) ?\\) | 4342 | (eq (char-after i) ?\\) |
| 3632 | (setq qtag t)) | 4343 | (setq qtag t)) |
| 3633 | (if (looking-at "\\sw*x") ; qr//x | 4344 | (and (if go (looking-at ".\\sw*x") |
| 3634 | (setq is-x-REx t)) | 4345 | (looking-at "\\sw*x")) ; qr//x |
| 4346 | (setq is-x-REx t)) | ||
| 4347 | (and (if go (looking-at ".\\sw*o") | ||
| 4348 | (looking-at "\\sw*o")) ; //o | ||
| 4349 | (setq is-o-REx t)) | ||
| 3635 | (if (null i) | 4350 | (if (null i) |
| 3636 | ;; Considered as 1arg form | 4351 | ;; Considered as 1arg form |
| 3637 | (progn | 4352 | (progn |
| @@ -3648,9 +4363,11 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', | |||
| 3648 | (cperl-commentify b i t) | 4363 | (cperl-commentify b i t) |
| 3649 | (if (looking-at "\\sw*e") ; s///e | 4364 | (if (looking-at "\\sw*e") ; s///e |
| 3650 | (progn | 4365 | (progn |
| 4366 | ;; Cache the syntax info... | ||
| 4367 | (setq cperl-syntax-state (cons state-point state)) | ||
| 3651 | (and | 4368 | (and |
| 3652 | ;; silent: | 4369 | ;; silent: |
| 3653 | (cperl-find-pods-heres b1 (1- (point)) t end) | 4370 | (car (cperl-find-pods-heres b1 (1- (point)) t end)) |
| 3654 | ;; Error | 4371 | ;; Error |
| 3655 | (goto-char (1+ max))) | 4372 | (goto-char (1+ max))) |
| 3656 | (if (and tag (eq (preceding-char) ?\>)) | 4373 | (if (and tag (eq (preceding-char) ?\>)) |
| @@ -3658,6 +4375,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', | |||
| 3658 | (cperl-modify-syntax-type (1- (point)) cperl-st-ket) | 4375 | (cperl-modify-syntax-type (1- (point)) cperl-st-ket) |
| 3659 | (cperl-modify-syntax-type i cperl-st-bra))) | 4376 | (cperl-modify-syntax-type i cperl-st-bra))) |
| 3660 | (put-text-property b i 'syntax-type 'string) | 4377 | (put-text-property b i 'syntax-type 'string) |
| 4378 | (put-text-property i (point) 'syntax-type 'multiline) | ||
| 3661 | (if is-x-REx | 4379 | (if is-x-REx |
| 3662 | (put-text-property b i 'indentable t))) | 4380 | (put-text-property b i 'indentable t))) |
| 3663 | (cperl-commentify b1 (point) t) | 4381 | (cperl-commentify b1 (point) t) |
| @@ -3673,7 +4391,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', | |||
| 3673 | (forward-word 1) ; skip modifiers s///s | 4391 | (forward-word 1) ; skip modifiers s///s |
| 3674 | (if tail (cperl-commentify tail (point) t)) | 4392 | (if tail (cperl-commentify tail (point) t)) |
| 3675 | (cperl-postpone-fontification | 4393 | (cperl-postpone-fontification |
| 3676 | e1 (point) 'face 'cperl-nonoverridable))) | 4394 | e1 (point) 'face my-cperl-REx-modifiers-face))) |
| 3677 | ;; Check whether it is m// which means "previous match" | 4395 | ;; Check whether it is m// which means "previous match" |
| 3678 | ;; and highlight differently | 4396 | ;; and highlight differently |
| 3679 | (setq is-REx | 4397 | (setq is-REx |
| @@ -3691,7 +4409,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', | |||
| 3691 | (not (looking-at "split\\>"))) | 4409 | (not (looking-at "split\\>"))) |
| 3692 | (error t)))) | 4410 | (error t)))) |
| 3693 | (cperl-postpone-fontification | 4411 | (cperl-postpone-fontification |
| 3694 | b e 'face font-lock-function-name-face) | 4412 | b e 'face font-lock-warning-face) |
| 3695 | (if (or i2 ; Has 2 args | 4413 | (if (or i2 ; Has 2 args |
| 3696 | (and cperl-fontify-m-as-s | 4414 | (and cperl-fontify-m-as-s |
| 3697 | (or | 4415 | (or |
| @@ -3700,135 +4418,417 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', | |||
| 3700 | (not (eq ?\< (char-after b))))))) | 4418 | (not (eq ?\< (char-after b))))))) |
| 3701 | (progn | 4419 | (progn |
| 3702 | (cperl-postpone-fontification | 4420 | (cperl-postpone-fontification |
| 3703 | b (cperl-1+ b) 'face font-lock-constant-face) | 4421 | b (cperl-1+ b) 'face my-cperl-delimiters-face) |
| 3704 | (cperl-postpone-fontification | 4422 | (cperl-postpone-fontification |
| 3705 | (1- e) e 'face font-lock-constant-face))) | 4423 | (1- e) e 'face my-cperl-delimiters-face))) |
| 3706 | (if (and is-REx cperl-regexp-scan) | 4424 | (if (and is-REx cperl-regexp-scan) |
| 3707 | ;; Process RExen better | 4425 | ;; Process RExen: embedded comments, charclasses and ] |
| 4426 | ;;;/\3333\xFg\x{FFF}a\ppp\PPP\qqq\C\99f(?{ foo })(??{ foo })/; | ||
| 4427 | ;;;/a\.b[^a[:ff:]b]x$ab->$[|$,$ab->[cd]->[ef]|$ab[xy].|^${a,b}{c,d}/; | ||
| 4428 | ;;;/(?<=foo)(?<!bar)(x)(?:$ab|\$\/)$|\\\b\x888\776\[\:$/xxx; | ||
| 4429 | ;;;m?(\?\?{b,a})? + m/(??{aa})(?(?=xx)aa|bb)(?#aac)/; | ||
| 4430 | ;;;m$(^ab[c]\$)$ + m+(^ab[c]\$\+)+ + m](^ab[c\]$|.+)] + m)(^ab[c]$|.+\)); | ||
| 4431 | ;;;m^a[\^b]c^ + m.a[^b]\.c.; | ||
| 3708 | (save-excursion | 4432 | (save-excursion |
| 3709 | (goto-char (1+ b)) | 4433 | (goto-char (1+ b)) |
| 4434 | ;; First | ||
| 4435 | (cperl-look-at-leading-count is-x-REx e) | ||
| 4436 | (setq hairy-RE | ||
| 4437 | (concat | ||
| 4438 | (if is-x-REx | ||
| 4439 | (if (eq (char-after b) ?\#) | ||
| 4440 | "\\((\\?\\\\#\\)\\|\\(\\\\#\\)" | ||
| 4441 | "\\((\\?#\\)\\|\\(#\\)") | ||
| 4442 | ;; keep the same count: add a fake group | ||
| 4443 | (if (eq (char-after b) ?\#) | ||
| 4444 | "\\((\\?\\\\#\\)\\(\\)" | ||
| 4445 | "\\((\\?#\\)\\(\\)")) | ||
| 4446 | "\\|" | ||
| 4447 | "\\(\\[\\)" ; 3=[ | ||
| 4448 | "\\|" | ||
| 4449 | "\\(]\\)" ; 4=] | ||
| 4450 | "\\|" | ||
| 4451 | ;; XXXX Will not be able to use it in s))) | ||
| 4452 | (if (eq (char-after b) ?\) ) | ||
| 4453 | "\\())))\\)" ; Will never match | ||
| 4454 | (if (eq (char-after b) ?? ) | ||
| 4455 | ;;"\\((\\\\\\?\\(\\\\\\?\\)?{\\)" | ||
| 4456 | "\\((\\\\\\?\\\\\\?{\\|()\\\\\\?{\\)" | ||
| 4457 | "\\((\\?\\??{\\)")) ; 5= (??{ (?{ | ||
| 4458 | "\\|" ; 6= 0-length, 7: name, 8,9:code, 10:group | ||
| 4459 | "\\(" ;; XXXX 1-char variables, exc. |()\s | ||
| 4460 | "[$@]" | ||
| 4461 | "\\(" | ||
| 4462 | "[_a-zA-Z:][_a-zA-Z0-9:]*" | ||
| 4463 | "\\|" | ||
| 4464 | "{[^{}]*}" ; only one-level allowed | ||
| 4465 | "\\|" | ||
| 4466 | "[^{(|) \t\r\n\f]" | ||
| 4467 | "\\)" | ||
| 4468 | "\\(" ;;8,9:code part of array/hash elt | ||
| 4469 | "\\(" "->" "\\)?" | ||
| 4470 | "\\[[^][]*\\]" | ||
| 4471 | "\\|" | ||
| 4472 | "{[^{}]*}" | ||
| 4473 | "\\)*" | ||
| 4474 | ;; XXXX: what if u is delim? | ||
| 4475 | "\\|" | ||
| 4476 | "[)^|$.*?+]" | ||
| 4477 | "\\|" | ||
| 4478 | "{[0-9]+}" | ||
| 4479 | "\\|" | ||
| 4480 | "{[0-9]+,[0-9]*}" | ||
| 4481 | "\\|" | ||
| 4482 | "\\\\[luLUEQbBAzZG]" | ||
| 4483 | "\\|" | ||
| 4484 | "(" ; Group opener | ||
| 4485 | "\\(" ; 10 group opener follower | ||
| 4486 | "\\?\\((\\?\\)" ; 11: in (?(?=C)A|B) | ||
| 4487 | "\\|" | ||
| 4488 | "\\?[:=!>?{]" ; "?" something | ||
| 4489 | "\\|" | ||
| 4490 | "\\?[-imsx]+[:)]" ; (?i) (?-s:.) | ||
| 4491 | "\\|" | ||
| 4492 | "\\?([0-9]+)" ; (?(1)foo|bar) | ||
| 4493 | "\\|" | ||
| 4494 | "\\?<[=!]" | ||
| 4495 | ;;;"\\|" | ||
| 4496 | ;;; "\\?" | ||
| 4497 | "\\)?" | ||
| 4498 | "\\)" | ||
| 4499 | "\\|" | ||
| 4500 | "\\\\\\(.\\)" ; 12=\SYMBOL | ||
| 4501 | )) | ||
| 3710 | (while | 4502 | (while |
| 3711 | (and (< (point) e) | 4503 | (and (< (point) (1- e)) |
| 3712 | (re-search-forward | 4504 | (re-search-forward hairy-RE (1- e) 'to-end)) |
| 3713 | (if is-x-REx | ||
| 3714 | (if (eq (char-after b) ?\#) | ||
| 3715 | "\\((\\?\\\\#\\)\\|\\(\\\\#\\)" | ||
| 3716 | "\\((\\?#\\)\\|\\(#\\)") | ||
| 3717 | (if (eq (char-after b) ?\#) | ||
| 3718 | "\\((\\?\\\\#\\)" | ||
| 3719 | "\\((\\?#\\)")) | ||
| 3720 | (1- e) 'to-end)) | ||
| 3721 | (goto-char (match-beginning 0)) | 4505 | (goto-char (match-beginning 0)) |
| 3722 | (setq REx-comment-start (point) | 4506 | (setq REx-subgr-start (point) |
| 3723 | was-comment t) | 4507 | was-subgr (following-char)) |
| 3724 | (if (save-excursion | 4508 | (cond |
| 3725 | (and | 4509 | ((match-beginning 6) ; 0-length builtins, groups |
| 3726 | ;; XXX not working if outside delimiter is # | 4510 | (goto-char (match-end 0)) |
| 3727 | (eq (preceding-char) ?\\) | 4511 | (if (match-beginning 11) |
| 3728 | (= (% (skip-chars-backward "$\\\\") 2) -1))) | 4512 | (goto-char (match-beginning 11))) |
| 3729 | ;; Not a comment, avoid loop: | 4513 | (if (>= (point) e) |
| 3730 | (progn (setq was-comment nil) | 4514 | (goto-char (1- e))) |
| 3731 | (forward-char 1)) | 4515 | (cperl-postpone-fontification |
| 3732 | (if (match-beginning 2) | 4516 | (match-beginning 0) (point) |
| 4517 | 'face | ||
| 4518 | (cond | ||
| 4519 | ((eq was-subgr ?\) ) | ||
| 4520 | (condition-case nil | ||
| 4521 | (save-excursion | ||
| 4522 | (forward-sexp -1) | ||
| 4523 | (if (> (point) b) | ||
| 4524 | (if (if (eq (char-after b) ?? ) | ||
| 4525 | (looking-at "(\\\\\\?") | ||
| 4526 | (eq (char-after (1+ (point))) ?\?)) | ||
| 4527 | my-cperl-REx-0length-face | ||
| 4528 | my-cperl-REx-ctl-face) | ||
| 4529 | font-lock-warning-face)) | ||
| 4530 | (error font-lock-warning-face))) | ||
| 4531 | ((eq was-subgr ?\| ) | ||
| 4532 | my-cperl-REx-ctl-face) | ||
| 4533 | ((eq was-subgr ?\$ ) | ||
| 4534 | (if (> (point) (1+ REx-subgr-start)) | ||
| 4535 | (progn | ||
| 4536 | (put-text-property | ||
| 4537 | (match-beginning 0) (point) | ||
| 4538 | 'REx-interpolated | ||
| 4539 | (if is-o-REx 0 | ||
| 4540 | (if (and (eq (match-beginning 0) | ||
| 4541 | (1+ b)) | ||
| 4542 | (eq (point) | ||
| 4543 | (1- e))) 1 t))) | ||
| 4544 | font-lock-variable-name-face) | ||
| 4545 | my-cperl-REx-spec-char-face)) | ||
| 4546 | ((memq was-subgr (append "^." nil) ) | ||
| 4547 | my-cperl-REx-spec-char-face) | ||
| 4548 | ((eq was-subgr ?\( ) | ||
| 4549 | (if (not (match-beginning 10)) | ||
| 4550 | my-cperl-REx-ctl-face | ||
| 4551 | my-cperl-REx-0length-face)) | ||
| 4552 | (t my-cperl-REx-0length-face))) | ||
| 4553 | (if (and (memq was-subgr (append "(|" nil)) | ||
| 4554 | (not (string-match "(\\?[-imsx]+)" | ||
| 4555 | (match-string 0)))) | ||
| 4556 | (cperl-look-at-leading-count is-x-REx e)) | ||
| 4557 | (setq was-subgr nil)) ; We do stuff here | ||
| 4558 | ((match-beginning 12) ; \SYMBOL | ||
| 4559 | (forward-char 2) | ||
| 4560 | (if (>= (point) e) | ||
| 4561 | (goto-char (1- e)) | ||
| 4562 | ;; How many chars to not highlight: | ||
| 4563 | ;; 0-len special-alnums in other branch => | ||
| 4564 | ;; Generic: \non-alnum (1), \alnum (1+face) | ||
| 4565 | ;; Is-delim: \non-alnum (1/spec-2) alnum-1 (=what hai) | ||
| 4566 | (setq REx-subgr-start (point) | ||
| 4567 | qtag (preceding-char)) | ||
| 4568 | (cperl-postpone-fontification | ||
| 4569 | (- (point) 2) (- (point) 1) 'face | ||
| 4570 | (if (memq qtag | ||
| 4571 | (append "ghijkmoqvFHIJKMORTVY" nil)) | ||
| 4572 | font-lock-warning-face | ||
| 4573 | my-cperl-REx-0length-face)) | ||
| 4574 | (if (and (eq (char-after b) qtag) | ||
| 4575 | (memq qtag (append ".])^$|*?+" nil))) | ||
| 4576 | (progn | ||
| 4577 | (if (and cperl-use-syntax-table-text-property | ||
| 4578 | (eq qtag ?\) )) | ||
| 4579 | (put-text-property | ||
| 4580 | REx-subgr-start (1- (point)) | ||
| 4581 | 'syntax-table cperl-st-punct)) | ||
| 4582 | (cperl-postpone-fontification | ||
| 4583 | (1- (point)) (point) 'face | ||
| 4584 | ; \] can't appear below | ||
| 4585 | (if (memq qtag (append ".]^$" nil)) | ||
| 4586 | 'my-cperl-REx-spec-char-face | ||
| 4587 | (if (memq qtag (append "*?+" nil)) | ||
| 4588 | 'my-cperl-REx-0length-face | ||
| 4589 | 'my-cperl-REx-ctl-face))))) ; )| | ||
| 4590 | ;; Test for arguments: | ||
| 4591 | (cond | ||
| 4592 | ;; This is not pretty: the 5.8.7 logic: | ||
| 4593 | ;; \0numx -> octal (up to total 3 dig) | ||
| 4594 | ;; \DIGIT -> backref unless \0 | ||
| 4595 | ;; \DIGITs -> backref if legal | ||
| 4596 | ;; otherwise up to 3 -> octal | ||
| 4597 | ;; Do not try to distinguish, we guess | ||
| 4598 | ((or (and (memq qtag (append "01234567" nil)) | ||
| 4599 | (re-search-forward | ||
| 4600 | "\\=[01234567]?[01234567]?" | ||
| 4601 | (1- e) 'to-end)) | ||
| 4602 | (and (memq qtag (append "89" nil)) | ||
| 4603 | (re-search-forward | ||
| 4604 | "\\=[0123456789]*" (1- e) 'to-end)) | ||
| 4605 | (and (eq qtag ?x) | ||
| 4606 | (re-search-forward | ||
| 4607 | "\\=[0-9a-fA-F][0-9a-fA-F]?\\|\\={[0-9a-fA-F]+}" | ||
| 4608 | (1- e) 'to-end)) | ||
| 4609 | (and (memq qtag (append "pPN" nil)) | ||
| 4610 | (re-search-forward "\\={[^{}]+}\\|." | ||
| 4611 | (1- e) 'to-end)) | ||
| 4612 | (eq (char-syntax qtag) ?w)) | ||
| 4613 | (cperl-postpone-fontification | ||
| 4614 | (1- REx-subgr-start) (point) | ||
| 4615 | 'face my-cperl-REx-length1-face)))) | ||
| 4616 | (setq was-subgr nil)) ; We do stuff here | ||
| 4617 | ((match-beginning 3) ; [charclass] | ||
| 4618 | (forward-char 1) | ||
| 4619 | (if (eq (char-after b) ?^ ) | ||
| 4620 | (and (eq (following-char) ?\\ ) | ||
| 4621 | (eq (char-after (cperl-1+ (point))) | ||
| 4622 | ?^ ) | ||
| 4623 | (forward-char 2)) | ||
| 4624 | (and (eq (following-char) ?^ ) | ||
| 4625 | (forward-char 1))) | ||
| 4626 | (setq argument b ; continue? | ||
| 4627 | tag nil ; list of POSIX classes | ||
| 4628 | qtag (point)) | ||
| 4629 | (if (eq (char-after b) ?\] ) | ||
| 4630 | (and (eq (following-char) ?\\ ) | ||
| 4631 | (eq (char-after (cperl-1+ (point))) | ||
| 4632 | ?\] ) | ||
| 4633 | (setq qtag (1+ qtag)) | ||
| 4634 | (forward-char 2)) | ||
| 4635 | (and (eq (following-char) ?\] ) | ||
| 4636 | (forward-char 1))) | ||
| 4637 | ;; Apparently, I can't put \] into a charclass | ||
| 4638 | ;; in m]]: m][\\\]\]] produces [\\]] | ||
| 4639 | ;;; POSIX? [:word:] [:^word:] only inside [] | ||
| 4640 | ;;; "\\=\\(\\\\.\\|[^][\\\\]\\|\\[:\\^?\sw+:]\\|\\[[^:]\\)*]") | ||
| 4641 | (while | ||
| 4642 | (and argument | ||
| 4643 | (re-search-forward | ||
| 4644 | (if (eq (char-after b) ?\] ) | ||
| 4645 | "\\=\\(\\\\[^]]\\|[^]\\\\]\\)*\\\\]" | ||
| 4646 | "\\=\\(\\\\.\\|[^]\\\\]\\)*]") | ||
| 4647 | (1- e) 'toend)) | ||
| 4648 | ;; Is this ] an end of POSIX class? | ||
| 4649 | (if (save-excursion | ||
| 4650 | (and | ||
| 4651 | (search-backward "[" argument t) | ||
| 4652 | (< REx-subgr-start (point)) | ||
| 4653 | (not | ||
| 4654 | (and ; Should work with delim = \ | ||
| 4655 | (eq (preceding-char) ?\\ ) | ||
| 4656 | (= (% (skip-chars-backward | ||
| 4657 | "\\\\") 2) 0))) | ||
| 4658 | (looking-at | ||
| 4659 | (cond | ||
| 4660 | ((eq (char-after b) ?\] ) | ||
| 4661 | "\\\\*\\[:\\^?\\sw+:\\\\\\]") | ||
| 4662 | ((eq (char-after b) ?\: ) | ||
| 4663 | "\\\\*\\[\\\\:\\^?\\sw+\\\\:]") | ||
| 4664 | ((eq (char-after b) ?^ ) | ||
| 4665 | "\\\\*\\[:\\(\\\\\\^\\)?\\sw+:\]") | ||
| 4666 | ((eq (char-syntax (char-after b)) | ||
| 4667 | ?w) | ||
| 4668 | (concat | ||
| 4669 | "\\\\*\\[:\\(\\\\\\^\\)?\\(\\\\" | ||
| 4670 | (char-to-string (char-after b)) | ||
| 4671 | "\\|\\sw\\)+:\]")) | ||
| 4672 | (t "\\\\*\\[:\\^?\\sw*:]"))) | ||
| 4673 | (setq argument (point)))) | ||
| 4674 | (setq tag (cons (cons argument (point)) | ||
| 4675 | tag) | ||
| 4676 | argument (point)) ; continue | ||
| 4677 | (setq argument nil))) | ||
| 4678 | (and argument | ||
| 4679 | (message "Couldn't find end of charclass in a REx, pos=%s" | ||
| 4680 | REx-subgr-start)) | ||
| 4681 | (if (and cperl-use-syntax-table-text-property | ||
| 4682 | (> (- (point) 2) REx-subgr-start)) | ||
| 4683 | (put-text-property | ||
| 4684 | (1+ REx-subgr-start) (1- (point)) | ||
| 4685 | 'syntax-table cperl-st-punct)) | ||
| 4686 | (cperl-postpone-fontification | ||
| 4687 | REx-subgr-start qtag | ||
| 4688 | 'face my-cperl-REx-spec-char-face) | ||
| 4689 | (cperl-postpone-fontification | ||
| 4690 | (1- (point)) (point) 'face | ||
| 4691 | my-cperl-REx-spec-char-face) | ||
| 4692 | (if (eq (char-after b) ?\] ) | ||
| 4693 | (cperl-postpone-fontification | ||
| 4694 | (- (point) 2) (1- (point)) | ||
| 4695 | 'face my-cperl-REx-0length-face)) | ||
| 4696 | (while tag | ||
| 4697 | (cperl-postpone-fontification | ||
| 4698 | (car (car tag)) (cdr (car tag)) | ||
| 4699 | 'face my-cperl-REx-length1-face) | ||
| 4700 | (setq tag (cdr tag))) | ||
| 4701 | (setq was-subgr nil)) ; did facing already | ||
| 4702 | ;; Now rare stuff: | ||
| 4703 | ((and (match-beginning 2) ; #-comment | ||
| 4704 | (/= (match-beginning 2) (match-end 2))) | ||
| 4705 | (beginning-of-line 2) | ||
| 4706 | (if (> (point) e) | ||
| 4707 | (goto-char (1- e)))) | ||
| 4708 | ((match-beginning 4) ; character "]" | ||
| 4709 | (setq was-subgr nil) ; We do stuff here | ||
| 4710 | (goto-char (match-end 0)) | ||
| 4711 | (if cperl-use-syntax-table-text-property | ||
| 4712 | (put-text-property | ||
| 4713 | (1- (point)) (point) | ||
| 4714 | 'syntax-table cperl-st-punct)) | ||
| 4715 | (cperl-postpone-fontification | ||
| 4716 | (1- (point)) (point) | ||
| 4717 | 'face font-lock-warning-face)) | ||
| 4718 | ((match-beginning 5) ; before (?{}) (??{}) | ||
| 4719 | (setq tag (match-end 0)) | ||
| 4720 | (if (or (setq qtag | ||
| 4721 | (cperl-forward-group-in-re st-l)) | ||
| 4722 | (and (>= (point) e) | ||
| 4723 | (setq qtag "no matching `)' found")) | ||
| 4724 | (and (not (eq (char-after (- (point) 2)) | ||
| 4725 | ?\} )) | ||
| 4726 | (setq qtag "Can't find })"))) | ||
| 3733 | (progn | 4727 | (progn |
| 3734 | (beginning-of-line 2) | 4728 | (goto-char (1- e)) |
| 3735 | (if (> (point) e) | 4729 | (message qtag)) |
| 3736 | (goto-char (1- e)))) | 4730 | (cperl-postpone-fontification |
| 3737 | ;; Works also if the outside delimiters are (). | 4731 | (1- tag) (1- (point)) |
| 3738 | (or (search-forward ")" (1- e) 'toend) | 4732 | 'face font-lock-variable-name-face) |
| 3739 | (message | 4733 | (cperl-postpone-fontification |
| 3740 | "Couldn't find end of (?#...)-comment in a REx, pos=%s" | 4734 | REx-subgr-start (1- tag) |
| 3741 | REx-comment-start)))) | 4735 | 'face my-cperl-REx-spec-char-face) |
| 4736 | (cperl-postpone-fontification | ||
| 4737 | (1- (point)) (point) | ||
| 4738 | 'face my-cperl-REx-spec-char-face) | ||
| 4739 | (if cperl-use-syntax-table-text-property | ||
| 4740 | (progn | ||
| 4741 | (put-text-property | ||
| 4742 | (- (point) 2) (1- (point)) | ||
| 4743 | 'syntax-table cperl-st-cfence) | ||
| 4744 | (put-text-property | ||
| 4745 | (+ REx-subgr-start 2) | ||
| 4746 | (+ REx-subgr-start 3) | ||
| 4747 | 'syntax-table cperl-st-cfence)))) | ||
| 4748 | (setq was-subgr nil)) | ||
| 4749 | (t ; (?#)-comment | ||
| 4750 | ;; Inside "(" and "\" arn't special in any way | ||
| 4751 | ;; Works also if the outside delimiters are (). | ||
| 4752 | (or;;(if (eq (char-after b) ?\) ) | ||
| 4753 | ;;(re-search-forward | ||
| 4754 | ;; "[^\\\\]\\(\\\\\\\\\\)*\\\\)" | ||
| 4755 | ;; (1- e) 'toend) | ||
| 4756 | (search-forward ")" (1- e) 'toend) | ||
| 4757 | ;;) | ||
| 4758 | (message | ||
| 4759 | "Couldn't find end of (?#...)-comment in a REx, pos=%s" | ||
| 4760 | REx-subgr-start)))) | ||
| 3742 | (if (>= (point) e) | 4761 | (if (>= (point) e) |
| 3743 | (goto-char (1- e))) | 4762 | (goto-char (1- e))) |
| 3744 | (if was-comment | 4763 | (cond |
| 3745 | (progn | 4764 | (was-subgr |
| 3746 | (setq REx-comment-end (point)) | 4765 | (setq REx-subgr-end (point)) |
| 3747 | (cperl-commentify | 4766 | (cperl-commentify |
| 3748 | REx-comment-start REx-comment-end nil) | 4767 | REx-subgr-start REx-subgr-end nil) |
| 3749 | (cperl-postpone-fontification | 4768 | (cperl-postpone-fontification |
| 3750 | REx-comment-start REx-comment-end | 4769 | REx-subgr-start REx-subgr-end |
| 3751 | 'face font-lock-comment-face)))))) | 4770 | 'face font-lock-comment-face)))))) |
| 3752 | (if (and is-REx is-x-REx) | 4771 | (if (and is-REx is-x-REx) |
| 3753 | (put-text-property (1+ b) (1- e) | 4772 | (put-text-property (1+ b) (1- e) |
| 3754 | 'syntax-subtype 'x-REx))) | 4773 | 'syntax-subtype 'x-REx))) |
| 3755 | (if i2 | 4774 | (if i2 |
| 3756 | (progn | 4775 | (progn |
| 3757 | (cperl-postpone-fontification | 4776 | (cperl-postpone-fontification |
| 3758 | (1- e1) e1 'face font-lock-constant-face) | 4777 | (1- e1) e1 'face my-cperl-delimiters-face) |
| 3759 | (if (assoc (char-after b) cperl-starters) | 4778 | (if (assoc (char-after b) cperl-starters) |
| 3760 | (cperl-postpone-fontification | 4779 | (progn |
| 3761 | b1 (1+ b1) 'face font-lock-constant-face)))) | 4780 | (cperl-postpone-fontification |
| 4781 | b1 (1+ b1) 'face my-cperl-delimiters-face) | ||
| 4782 | (put-text-property b1 (1+ b1) | ||
| 4783 | 'REx-part2 t))))) | ||
| 3762 | (if (> (point) max) | 4784 | (if (> (point) max) |
| 3763 | (setq tmpend tb)))) | 4785 | (setq tmpend tb)))) |
| 3764 | ((match-beginning 13) ; sub with prototypes | 4786 | ((match-beginning 17) ; sub with prototype or attribute |
| 3765 | (setq b (match-beginning 0)) | 4787 | ;; 1+6+2+1+1=11 extra () before this (sub with proto/attr): |
| 4788 | ;;"\\<sub\\>\\(" ;12 | ||
| 4789 | ;; cperl-white-and-comment-rex ;13 | ||
| 4790 | ;; "\\([a-zA-Z_:'0-9]+\\)\\)?" ; name ;14 | ||
| 4791 | ;;"\\(" cperl-maybe-white-and-comment-rex ;15,16 | ||
| 4792 | ;; "\\(([^()]*)\\|:[^:]\\)\\)" ; 17:proto or attribute start | ||
| 4793 | (setq b1 (match-beginning 14) e1 (match-end 14)) | ||
| 3766 | (if (memq (char-after (1- b)) | 4794 | (if (memq (char-after (1- b)) |
| 3767 | '(?\$ ?\@ ?\% ?\& ?\*)) | 4795 | '(?\$ ?\@ ?\% ?\& ?\*)) |
| 3768 | nil | 4796 | nil |
| 3769 | (setq state (parse-partial-sexp | 4797 | (goto-char b) |
| 3770 | state-point b nil nil state) | 4798 | (if (eq (char-after (match-beginning 17)) ?\( ) |
| 3771 | state-point b) | 4799 | (progn |
| 3772 | (if (or (nth 3 state) (nth 4 state)) | 4800 | (cperl-commentify ; Prototypes; mark as string |
| 3773 | nil | 4801 | (match-beginning 17) (match-end 17) t) |
| 3774 | ;; Mark as string | 4802 | (goto-char (match-end 0)) |
| 3775 | (cperl-commentify (match-beginning 13) (match-end 13) t)) | 4803 | ;; Now look for attributes after prototype: |
| 3776 | (goto-char (match-end 0)))) | 4804 | (forward-comment (buffer-size)) |
| 3777 | ;; 1+6+2+1+1+2=13 extra () before this: | 4805 | (and (looking-at ":[^:]") |
| 3778 | ;; "\\$\\(['{]\\)" | 4806 | (cperl-find-sub-attrs st-l b1 e1 b))) |
| 3779 | ((and (match-beginning 14) | 4807 | ;; treat attributes without prototype |
| 3780 | (eq (preceding-char) ?\')) ; $' | 4808 | (goto-char (match-beginning 17)) |
| 3781 | (setq b (1- (point)) | 4809 | (cperl-find-sub-attrs st-l b1 e1 b)))) |
| 3782 | state (parse-partial-sexp | 4810 | ;; 1+6+2+1+1+6+1=18 extra () before this: |
| 3783 | state-point (1- b) nil nil state) | ||
| 3784 | state-point (1- b)) | ||
| 3785 | (if (nth 3 state) ; in string | ||
| 3786 | (cperl-modify-syntax-type (1- b) cperl-st-punct)) | ||
| 3787 | (goto-char (1+ b))) | ||
| 3788 | ;; 1+6+2+1+1+2=13 extra () before this: | ||
| 3789 | ;; "\\$\\(['{]\\)" | ||
| 3790 | ((match-beginning 14) ; ${ | ||
| 3791 | (setq bb (match-beginning 0)) | ||
| 3792 | (cperl-modify-syntax-type bb cperl-st-punct)) | ||
| 3793 | ;; 1+6+2+1+1+2+1=14 extra () before this: | ||
| 3794 | ;; "\\(\\<sub[ \t\n\f]+\\|[&*$@%]\\)[a-zA-Z0-9_]*'") | 4811 | ;; "\\(\\<sub[ \t\n\f]+\\|[&*$@%]\\)[a-zA-Z0-9_]*'") |
| 3795 | ((match-beginning 15) ; old $abc'efg syntax | 4812 | ((match-beginning 19) ; old $abc'efg syntax |
| 3796 | (setq bb (match-end 0) | 4813 | (setq bb (match-end 0)) |
| 3797 | b (match-beginning 0) | 4814 | ;;;(if (nth 3 state) nil ; in string |
| 3798 | state (parse-partial-sexp | 4815 | (put-text-property (1- bb) bb 'syntax-table cperl-st-word) |
| 3799 | state-point b nil nil state) | ||
| 3800 | state-point b) | ||
| 3801 | (if (nth 3 state) ; in string | ||
| 3802 | nil | ||
| 3803 | (put-text-property (1- bb) bb 'syntax-table cperl-st-word)) | ||
| 3804 | (goto-char bb)) | 4816 | (goto-char bb)) |
| 3805 | ;; 1+6+2+1+1+2+1+1=15 extra () before this: | 4817 | ;; 1+6+2+1+1+6+1+1=19 extra () before this: |
| 3806 | ;; "__\\(END\\|DATA\\)__" | 4818 | ;; "__\\(END\\|DATA\\)__" |
| 3807 | ((match-beginning 16) ; __END__, __DATA__ | 4819 | ((match-beginning 20) ; __END__, __DATA__ |
| 3808 | (setq bb (match-end 0) | 4820 | (setq bb (match-end 0)) |
| 3809 | b (match-beginning 0) | 4821 | ;; (put-text-property b (1+ bb) 'syntax-type 'pod) ; Cheat |
| 3810 | state (parse-partial-sexp | 4822 | (cperl-commentify b bb nil) |
| 3811 | state-point b nil nil state) | 4823 | (setq end t)) |
| 3812 | state-point b) | 4824 | ;; "\\\\\\(['`\"($]\\)" |
| 3813 | (if (or (nth 3 state) (nth 4 state)) | 4825 | ((match-beginning 21) |
| 3814 | nil | 4826 | ;; Trailing backslash; make non-quoting outside string/comment |
| 3815 | ;; (put-text-property b (1+ bb) 'syntax-type 'pod) ; Cheat | 4827 | (setq bb (match-end 0)) |
| 3816 | (cperl-commentify b bb nil) | ||
| 3817 | (setq end t)) | ||
| 3818 | (goto-char bb)) | ||
| 3819 | ((match-beginning 17) ; "\\\\\\(['`\"($]\\)" | ||
| 3820 | ;; Trailing backslash ==> non-quoting outside string/comment | ||
| 3821 | (setq bb (match-end 0) | ||
| 3822 | b (match-beginning 0)) | ||
| 3823 | (goto-char b) | 4828 | (goto-char b) |
| 3824 | (skip-chars-backward "\\\\") | 4829 | (skip-chars-backward "\\\\") |
| 3825 | ;;;(setq i2 (= (% (skip-chars-backward "\\\\") 2) -1)) | 4830 | ;;;(setq i2 (= (% (skip-chars-backward "\\\\") 2) -1)) |
| 3826 | (setq state (parse-partial-sexp | 4831 | (cperl-modify-syntax-type b cperl-st-punct) |
| 3827 | state-point b nil nil state) | ||
| 3828 | state-point b) | ||
| 3829 | (if (or (nth 3 state) (nth 4 state) ) | ||
| 3830 | nil | ||
| 3831 | (cperl-modify-syntax-type b cperl-st-punct)) | ||
| 3832 | (goto-char bb)) | 4832 | (goto-char bb)) |
| 3833 | (t (error "Error in regexp of the sniffer"))) | 4833 | (t (error "Error in regexp of the sniffer"))) |
| 3834 | (if (> (point) stop-point) | 4834 | (if (> (point) stop-point) |
| @@ -3839,7 +4839,10 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', | |||
| 3839 | (or (car err-l) (setcar err-l b))) | 4839 | (or (car err-l) (setcar err-l b))) |
| 3840 | (goto-char stop-point)))) | 4840 | (goto-char stop-point)))) |
| 3841 | (setq cperl-syntax-state (cons state-point state) | 4841 | (setq cperl-syntax-state (cons state-point state) |
| 3842 | cperl-syntax-done-to (or tmpend (max (point) max)))) | 4842 | ;; Do not mark syntax as done past tmpend??? |
| 4843 | cperl-syntax-done-to (or tmpend (max (point) max))) | ||
| 4844 | ;;(message "state-at=%s, done-to=%s" state-point cperl-syntax-done-to) | ||
| 4845 | ) | ||
| 3843 | (if (car err-l) (goto-char (car err-l)) | 4846 | (if (car err-l) (goto-char (car err-l)) |
| 3844 | (or non-inter | 4847 | (or non-inter |
| 3845 | (message "Scanning for \"hard\" Perl constructions... done")))) | 4848 | (message "Scanning for \"hard\" Perl constructions... done")))) |
| @@ -3851,48 +4854,91 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', | |||
| 3851 | ;; cperl-mode-syntax-table. | 4854 | ;; cperl-mode-syntax-table. |
| 3852 | ;; (set-syntax-table cperl-mode-syntax-table) | 4855 | ;; (set-syntax-table cperl-mode-syntax-table) |
| 3853 | ) | 4856 | ) |
| 3854 | (car err-l))) | 4857 | (list (car err-l) overshoot))) |
| 4858 | |||
| 4859 | (defun cperl-find-pods-heres-region (min max) | ||
| 4860 | (interactive "r") | ||
| 4861 | (cperl-find-pods-heres min max)) | ||
| 3855 | 4862 | ||
| 3856 | (defun cperl-backward-to-noncomment (lim) | 4863 | (defun cperl-backward-to-noncomment (lim) |
| 3857 | ;; Stops at lim or after non-whitespace that is not in comment | 4864 | ;; Stops at lim or after non-whitespace that is not in comment |
| 4865 | ;; XXXX Wrongly understands end-of-multiline strings with # as comment | ||
| 3858 | (let (stop p pr) | 4866 | (let (stop p pr) |
| 3859 | (while (and (not stop) (> (point) (or lim 1))) | 4867 | (while (and (not stop) (> (point) (or lim (point-min)))) |
| 3860 | (skip-chars-backward " \t\n\f" lim) | 4868 | (skip-chars-backward " \t\n\f" lim) |
| 3861 | (setq p (point)) | 4869 | (setq p (point)) |
| 3862 | (beginning-of-line) | 4870 | (beginning-of-line) |
| 3863 | (if (memq (setq pr (get-text-property (point) 'syntax-type)) | 4871 | (if (memq (setq pr (get-text-property (point) 'syntax-type)) |
| 3864 | '(pod here-doc here-doc-delim)) | 4872 | '(pod here-doc here-doc-delim)) |
| 3865 | (cperl-unwind-to-safe nil) | 4873 | (cperl-unwind-to-safe nil) |
| 3866 | (or (looking-at "^[ \t]*\\(#\\|$\\)") | 4874 | (or (and (looking-at "^[ \t]*\\(#\\|$\\)") |
| 3867 | (progn (cperl-to-comment-or-eol) (bolp)) | 4875 | (not (memq pr '(string prestring)))) |
| 3868 | (progn | 4876 | (progn (cperl-to-comment-or-eol) (bolp)) |
| 3869 | (skip-chars-backward " \t") | 4877 | (progn |
| 3870 | (if (< p (point)) (goto-char p)) | 4878 | (skip-chars-backward " \t") |
| 3871 | (setq stop t))))))) | 4879 | (if (< p (point)) (goto-char p)) |
| 4880 | (setq stop t))))))) | ||
| 3872 | 4881 | ||
| 4882 | ;; Used only in `cperl-calculate-indent'... | ||
| 4883 | (defun cperl-block-p () ; Do not C-M-q ! One string contains ";" ! | ||
| 4884 | ;; Positions is before ?\{. Checks whether it starts a block. | ||
| 4885 | ;; No save-excursion! This is more a distinguisher of a block/hash ref... | ||
| 4886 | (cperl-backward-to-noncomment (point-min)) | ||
| 4887 | (or (memq (preceding-char) (append ";){}$@&%\C-@" nil)) ; Or label! \C-@ at bobp | ||
| 4888 | ; Label may be mixed up with `$blah :' | ||
| 4889 | (save-excursion (cperl-after-label)) | ||
| 4890 | (get-text-property (cperl-1- (point)) 'attrib-group) | ||
| 4891 | (and (memq (char-syntax (preceding-char)) '(?w ?_)) | ||
| 4892 | (progn | ||
| 4893 | (backward-sexp) | ||
| 4894 | ;; sub {BLK}, print {BLK} $data, but NOT `bless', `return', `tr' | ||
| 4895 | (or (and (looking-at "[a-zA-Z0-9_:]+[ \t\n\f]*[{#]") ; Method call syntax | ||
| 4896 | (not (looking-at "\\(bless\\|return\\|q[wqrx]?\\|tr\\|[smy]\\)\\>"))) | ||
| 4897 | ;; sub bless::foo {} | ||
| 4898 | (progn | ||
| 4899 | (cperl-backward-to-noncomment (point-min)) | ||
| 4900 | (and (eq (preceding-char) ?b) | ||
| 4901 | (progn | ||
| 4902 | (forward-sexp -1) | ||
| 4903 | (looking-at "sub[ \t\n\f#]"))))))))) | ||
| 4904 | |||
| 4905 | ;;; What is the difference of (cperl-after-block-p lim t) and (cperl-block-p)? | ||
| 4906 | ;;; No save-excursion; condition-case ... In (cperl-block-p) the block | ||
| 4907 | ;;; may be a part of an in-statement construct, such as | ||
| 4908 | ;;; ${something()}, print {FH} $data. | ||
| 4909 | ;;; Moreover, one takes positive approach (looks for else,grep etc) | ||
| 4910 | ;;; another negative (looks for bless,tr etc) | ||
| 3873 | (defun cperl-after-block-p (lim &optional pre-block) | 4911 | (defun cperl-after-block-p (lim &optional pre-block) |
| 3874 | "Return true if the preceeding } ends a block or a following { starts one. | 4912 | "Return true if the preceeding } (if PRE-BLOCK, following {) delimits a block. |
| 3875 | Would not look before LIM. If PRE-BLOCK is nil checks preceeding }. | 4913 | Would not look before LIM. Assumes that LIM is a good place to begin a |
| 3876 | otherwise following {." | 4914 | statement. The kind of block we treat here is one after which a new |
| 3877 | ;; We suppose that the preceding char is }. | 4915 | statement would start; thus the block in ${func()} does not count." |
| 3878 | (save-excursion | 4916 | (save-excursion |
| 3879 | (condition-case nil | 4917 | (condition-case nil |
| 3880 | (progn | 4918 | (progn |
| 3881 | (or pre-block (forward-sexp -1)) | 4919 | (or pre-block (forward-sexp -1)) |
| 3882 | (cperl-backward-to-noncomment lim) | 4920 | (cperl-backward-to-noncomment lim) |
| 3883 | (or (eq (point) lim) | 4921 | (or (eq (point) lim) |
| 3884 | (eq (preceding-char) ?\) ) ; if () {} sub f () {} | 4922 | ;; if () {} // sub f () {} // sub f :a(') {} |
| 3885 | (if (eq (char-syntax (preceding-char)) ?w) ; else {} | 4923 | (eq (preceding-char) ?\) ) |
| 4924 | ;; label: {} | ||
| 4925 | (save-excursion (cperl-after-label)) | ||
| 4926 | ;; sub :attr {} | ||
| 4927 | (get-text-property (cperl-1- (point)) 'attrib-group) | ||
| 4928 | (if (memq (char-syntax (preceding-char)) '(?w ?_)) ; else {} | ||
| 3886 | (save-excursion | 4929 | (save-excursion |
| 3887 | (forward-sexp -1) | 4930 | (forward-sexp -1) |
| 3888 | (or (looking-at "\\(else\\|continue\\|grep\\|map\\|BEGIN\\|END\\|CHECK\\|INIT\\)\\>") | 4931 | ;; else {} but not else::func {} |
| 4932 | (or (and (looking-at "\\(else\\|continue\\|grep\\|map\\|BEGIN\\|END\\|CHECK\\|INIT\\)\\>") | ||
| 4933 | (not (looking-at "\\(\\sw\\|_\\)+::"))) | ||
| 3889 | ;; sub f {} | 4934 | ;; sub f {} |
| 3890 | (progn | 4935 | (progn |
| 3891 | (cperl-backward-to-noncomment lim) | 4936 | (cperl-backward-to-noncomment lim) |
| 3892 | (and (eq (char-syntax (preceding-char)) ?w) | 4937 | (and (eq (preceding-char) ?b) |
| 3893 | (progn | 4938 | (progn |
| 3894 | (forward-sexp -1) | 4939 | (forward-sexp -1) |
| 3895 | (looking-at "sub\\>")))))) | 4940 | (looking-at "sub[ \t\n\f#]")))))) |
| 4941 | ;; What preceeds is not word... XXXX Last statement in sub??? | ||
| 3896 | (cperl-after-expr-p lim)))) | 4942 | (cperl-after-expr-p lim)))) |
| 3897 | (error nil)))) | 4943 | (error nil)))) |
| 3898 | 4944 | ||
| @@ -3914,12 +4960,12 @@ CHARS is a string that contains good characters to have before us (however, | |||
| 3914 | (if (get-text-property (point) 'here-doc-group) | 4960 | (if (get-text-property (point) 'here-doc-group) |
| 3915 | (progn | 4961 | (progn |
| 3916 | (goto-char | 4962 | (goto-char |
| 3917 | (previous-single-property-change (point) 'here-doc-group)) | 4963 | (cperl-beginning-of-property (point) 'here-doc-group)) |
| 3918 | (beginning-of-line 0))) | 4964 | (beginning-of-line 0))) |
| 3919 | (if (get-text-property (point) 'in-pod) | 4965 | (if (get-text-property (point) 'in-pod) |
| 3920 | (progn | 4966 | (progn |
| 3921 | (goto-char | 4967 | (goto-char |
| 3922 | (previous-single-property-change (point) 'in-pod)) | 4968 | (cperl-beginning-of-property (point) 'in-pod)) |
| 3923 | (beginning-of-line 0))) | 4969 | (beginning-of-line 0))) |
| 3924 | (if (looking-at "^[ \t]*\\(#\\|$\\)") nil ; Only comment, skip | 4970 | (if (looking-at "^[ \t]*\\(#\\|$\\)") nil ; Only comment, skip |
| 3925 | ;; Else: last iteration, or a label | 4971 | ;; Else: last iteration, or a label |
| @@ -3931,7 +4977,7 @@ CHARS is a string that contains good characters to have before us (however, | |||
| 3931 | (progn | 4977 | (progn |
| 3932 | (forward-char -1) | 4978 | (forward-char -1) |
| 3933 | (skip-chars-backward " \t\n\f" lim) | 4979 | (skip-chars-backward " \t\n\f" lim) |
| 3934 | (eq (char-syntax (preceding-char)) ?w))) | 4980 | (memq (char-syntax (preceding-char)) '(?w ?_)))) |
| 3935 | (forward-sexp -1) ; Possibly label. Skip it | 4981 | (forward-sexp -1) ; Possibly label. Skip it |
| 3936 | (goto-char p) | 4982 | (goto-char p) |
| 3937 | (setq stop t)))) | 4983 | (setq stop t)))) |
| @@ -3947,6 +4993,44 @@ CHARS is a string that contains good characters to have before us (however, | |||
| 3947 | (eq (get-text-property (point) 'syntax-type) | 4993 | (eq (get-text-property (point) 'syntax-type) |
| 3948 | 'format))))))))) | 4994 | 'format))))))))) |
| 3949 | 4995 | ||
| 4996 | (defun cperl-backward-to-start-of-expr (&optional lim) | ||
| 4997 | (condition-case nil | ||
| 4998 | (progn | ||
| 4999 | (while (and (or (not lim) | ||
| 5000 | (> (point) lim)) | ||
| 5001 | (not (cperl-after-expr-p lim))) | ||
| 5002 | (forward-sexp -1) | ||
| 5003 | ;; May be after $, @, $# etc of a variable | ||
| 5004 | (skip-chars-backward "$@%#"))) | ||
| 5005 | (error nil))) | ||
| 5006 | |||
| 5007 | (defun cperl-at-end-of-expr (&optional lim) | ||
| 5008 | ;; Since the SEXP approach below is very fragile, do some overengineering | ||
| 5009 | (or (looking-at (concat cperl-maybe-white-and-comment-rex "[;}]")) | ||
| 5010 | (condition-case nil | ||
| 5011 | (save-excursion | ||
| 5012 | ;; If nothing interesting after, does as (forward-sexp -1); | ||
| 5013 | ;; otherwise fails, or ends at a start of following sexp. | ||
| 5014 | ;; XXXX PROBLEMS: if what follows (after ";") @FOO, or ${bar} | ||
| 5015 | ;; may be stuck after @ or $; just put some stupid workaround now: | ||
| 5016 | (let ((p (point))) | ||
| 5017 | (forward-sexp 1) | ||
| 5018 | (forward-sexp -1) | ||
| 5019 | (while (memq (preceding-char) (append "%&@$*" nil)) | ||
| 5020 | (forward-char -1)) | ||
| 5021 | (or (< (point) p) | ||
| 5022 | (cperl-after-expr-p lim)))) | ||
| 5023 | (error t)))) | ||
| 5024 | |||
| 5025 | (defun cperl-forward-to-end-of-expr (&optional lim) | ||
| 5026 | (let ((p (point)))) | ||
| 5027 | (condition-case nil | ||
| 5028 | (progn | ||
| 5029 | (while (and (< (point) (or lim (point-max))) | ||
| 5030 | (not (cperl-at-end-of-expr))) | ||
| 5031 | (forward-sexp 1))) | ||
| 5032 | (error nil))) | ||
| 5033 | |||
| 3950 | (defun cperl-backward-to-start-of-continued-exp (lim) | 5034 | (defun cperl-backward-to-start-of-continued-exp (lim) |
| 3951 | (if (memq (preceding-char) (append ")]}\"'`" nil)) | 5035 | (if (memq (preceding-char) (append ")]}\"'`" nil)) |
| 3952 | (forward-sexp -1)) | 5036 | (forward-sexp -1)) |
| @@ -3987,18 +5071,51 @@ conditional/loop constructs." | |||
| 3987 | (beginning-of-line) | 5071 | (beginning-of-line) |
| 3988 | (while (null done) | 5072 | (while (null done) |
| 3989 | (setq top (point)) | 5073 | (setq top (point)) |
| 3990 | (while (= (nth 0 (parse-partial-sexp (point) tmp-end | 5074 | ;; Plan A: if line has an unfinished paren-group, go to end-of-group |
| 3991 | -1)) -1) | 5075 | (while (= -1 (nth 0 (parse-partial-sexp (point) tmp-end -1))) |
| 3992 | (setq top (point))) ; Get the outermost parenths in line | 5076 | (setq top (point))) ; Get the outermost parenths in line |
| 3993 | (goto-char top) | 5077 | (goto-char top) |
| 3994 | (while (< (point) tmp-end) | 5078 | (while (< (point) tmp-end) |
| 3995 | (parse-partial-sexp (point) tmp-end nil t) ; To start-sexp or eol | 5079 | (parse-partial-sexp (point) tmp-end nil t) ; To start-sexp or eol |
| 3996 | (or (eolp) (forward-sexp 1))) | 5080 | (or (eolp) (forward-sexp 1))) |
| 3997 | (if (> (point) tmp-end) | 5081 | (if (> (point) tmp-end) ; Yes, there an unfinished block |
| 3998 | (save-excursion | 5082 | nil |
| 3999 | (end-of-line) | 5083 | (if (eq ?\) (preceding-char)) |
| 4000 | (setq tmp-end (point))) | 5084 | (progn ;; Plan B: find by REGEXP block followup this line |
| 4001 | (setq done t))) | 5085 | (setq top (point)) |
| 5086 | (condition-case nil | ||
| 5087 | (progn | ||
| 5088 | (forward-sexp -2) | ||
| 5089 | (if (eq (following-char) ?$ ) ; for my $var (list) | ||
| 5090 | (progn | ||
| 5091 | (forward-sexp -1) | ||
| 5092 | (if (looking-at "\\(my\\|local\\|our\\)\\>") | ||
| 5093 | (forward-sexp -1)))) | ||
| 5094 | (if (looking-at | ||
| 5095 | (concat "\\(\\elsif\\|if\\|unless\\|while\\|until" | ||
| 5096 | "\\|for\\(each\\)?\\>\\(\\(" | ||
| 5097 | cperl-maybe-white-and-comment-rex | ||
| 5098 | "\\(my\\|local\\|our\\)\\)?" | ||
| 5099 | cperl-maybe-white-and-comment-rex | ||
| 5100 | "\\$[_a-zA-Z0-9]+\\)?\\)\\>")) | ||
| 5101 | (progn | ||
| 5102 | (goto-char top) | ||
| 5103 | (forward-sexp 1) | ||
| 5104 | (setq top (point))))) | ||
| 5105 | (error (setq done t))) | ||
| 5106 | (goto-char top)) | ||
| 5107 | (if (looking-at ; Try Plan C: continuation block | ||
| 5108 | (concat cperl-maybe-white-and-comment-rex | ||
| 5109 | "\\<\\(else\\|elsif\|continue\\)\\>")) | ||
| 5110 | (progn | ||
| 5111 | (goto-char (match-end 0)) | ||
| 5112 | (save-excursion | ||
| 5113 | (end-of-line) | ||
| 5114 | (setq tmp-end (point)))) | ||
| 5115 | (setq done t)))) | ||
| 5116 | (save-excursion | ||
| 5117 | (end-of-line) | ||
| 5118 | (setq tmp-end (point)))) | ||
| 4002 | (goto-char tmp-end) | 5119 | (goto-char tmp-end) |
| 4003 | (setq tmp-end (point-marker))) | 5120 | (setq tmp-end (point-marker))) |
| 4004 | (if cperl-indent-region-fix-constructs | 5121 | (if cperl-indent-region-fix-constructs |
| @@ -4027,16 +5144,26 @@ Returns some position at the last line." | |||
| 4027 | ;; Looking at: | 5144 | ;; Looking at: |
| 4028 | ;; } | 5145 | ;; } |
| 4029 | ;; else | 5146 | ;; else |
| 4030 | (if (and cperl-merge-trailing-else | 5147 | (if cperl-merge-trailing-else |
| 4031 | (looking-at | 5148 | (if (looking-at |
| 4032 | "[ \t]*}[ \t]*\n[ \t\n]*\\(els\\(e\\|if\\)\\|continue\\)\\>")) | 5149 | "[ \t]*}[ \t]*\n[ \t\n]*\\(els\\(e\\|if\\)\\|continue\\)\\>") |
| 4033 | (progn | 5150 | (progn |
| 4034 | (search-forward "}") | 5151 | (search-forward "}") |
| 4035 | (setq p (point)) | 5152 | (setq p (point)) |
| 4036 | (skip-chars-forward " \t\n") | 5153 | (skip-chars-forward " \t\n") |
| 4037 | (delete-region p (point)) | 5154 | (delete-region p (point)) |
| 4038 | (insert (make-string cperl-indent-region-fix-constructs ?\s)) | 5155 | (insert (make-string cperl-indent-region-fix-constructs ?\s)) |
| 4039 | (beginning-of-line))) | 5156 | (beginning-of-line))) |
| 5157 | (if (looking-at "[ \t]*}[ \t]*\\(els\\(e\\|if\\)\\|continue\\)\\>") | ||
| 5158 | (save-excursion | ||
| 5159 | (search-forward "}") | ||
| 5160 | (delete-horizontal-space) | ||
| 5161 | (insert "\n") | ||
| 5162 | (setq ret (point)) | ||
| 5163 | (if (cperl-indent-line parse-data) | ||
| 5164 | (progn | ||
| 5165 | (cperl-fix-line-spacing end parse-data) | ||
| 5166 | (setq ret (point))))))) | ||
| 4040 | ;; Looking at: | 5167 | ;; Looking at: |
| 4041 | ;; } else | 5168 | ;; } else |
| 4042 | (if (looking-at "[ \t]*}\\(\t*\\|[ \t][ \t]+\\)\\<\\(els\\(e\\|if\\)\\|continue\\)\\>") | 5169 | (if (looking-at "[ \t]*}\\(\t*\\|[ \t][ \t]+\\)\\<\\(els\\(e\\|if\\)\\|continue\\)\\>") |
| @@ -4073,19 +5200,19 @@ Returns some position at the last line." | |||
| 4073 | (insert | 5200 | (insert |
| 4074 | (make-string cperl-indent-region-fix-constructs ?\s)) | 5201 | (make-string cperl-indent-region-fix-constructs ?\s)) |
| 4075 | (beginning-of-line))) | 5202 | (beginning-of-line))) |
| 4076 | ;; Looking at: | 5203 | ;; Looking at (with or without "}" at start, ending after "({"): |
| 4077 | ;; } foreach my $var () { | 5204 | ;; } foreach my $var () OR { |
| 4078 | (if (looking-at | 5205 | (if (looking-at |
| 4079 | "[ \t]*\\(}[ \t]*\\)?\\<\\(\\els\\(e\\|if\\)\\|continue\\|if\\|unless\\|while\\|for\\(each\\)?\\(\\([ \t]+\\(my\\|local\\|our\\)\\)?[ \t]*\\$[_a-zA-Z0-9]+\\)?\\|until\\)\\>\\([ \t]*(\\|[ \t\n]*{\\)\\|[ \t]*{") | 5206 | "[ \t]*\\(}[ \t]*\\)?\\<\\(\\els\\(e\\|if\\)\\|continue\\|if\\|unless\\|while\\|for\\(each\\)?\\(\\([ \t]+\\(my\\|local\\|our\\)\\)?[ \t]*\\$[_a-zA-Z0-9]+\\)?\\|until\\)\\>\\([ \t]*(\\|[ \t\n]*{\\)\\|[ \t]*{") |
| 4080 | (progn | 5207 | (progn |
| 4081 | (setq ml (match-beginning 8)) | 5208 | (setq ml (match-beginning 8)) ; "(" or "{" after control word |
| 4082 | (re-search-forward "[({]") | 5209 | (re-search-forward "[({]") |
| 4083 | (forward-char -1) | 5210 | (forward-char -1) |
| 4084 | (setq p (point)) | 5211 | (setq p (point)) |
| 4085 | (if (eq (following-char) ?\( ) | 5212 | (if (eq (following-char) ?\( ) |
| 4086 | (progn | 5213 | (progn |
| 4087 | (forward-sexp 1) | 5214 | (forward-sexp 1) |
| 4088 | (setq pp (point))) | 5215 | (setq pp (point))) ; past parenth-group |
| 4089 | ;; after `else' or nothing | 5216 | ;; after `else' or nothing |
| 4090 | (if ml ; after `else' | 5217 | (if ml ; after `else' |
| 4091 | (skip-chars-backward " \t\n") | 5218 | (skip-chars-backward " \t\n") |
| @@ -4095,13 +5222,13 @@ Returns some position at the last line." | |||
| 4095 | ;; Multiline expr should be special | 5222 | ;; Multiline expr should be special |
| 4096 | (setq ml (and pp (save-excursion (goto-char p) | 5223 | (setq ml (and pp (save-excursion (goto-char p) |
| 4097 | (search-forward "\n" pp t)))) | 5224 | (search-forward "\n" pp t)))) |
| 4098 | (if (and (or (not pp) (< pp end)) | 5225 | (if (and (or (not pp) (< pp end)) ; Do not go too far... |
| 4099 | (looking-at "[ \t\n]*{")) | 5226 | (looking-at "[ \t\n]*{")) |
| 4100 | (progn | 5227 | (progn |
| 4101 | (cond | 5228 | (cond |
| 4102 | ((bolp) ; Were before `{', no if/else/etc | 5229 | ((bolp) ; Were before `{', no if/else/etc |
| 4103 | nil) | 5230 | nil) |
| 4104 | ((looking-at "\\(\t*\\| [ \t]+\\){") | 5231 | ((looking-at "\\(\t*\\| [ \t]+\\){") ; Not exactly 1 SPACE |
| 4105 | (delete-horizontal-space) | 5232 | (delete-horizontal-space) |
| 4106 | (if (if ml | 5233 | (if (if ml |
| 4107 | cperl-extra-newline-before-brace-multiline | 5234 | cperl-extra-newline-before-brace-multiline |
| @@ -4124,7 +5251,17 @@ Returns some position at the last line." | |||
| 4124 | (skip-chars-forward " \t\n") | 5251 | (skip-chars-forward " \t\n") |
| 4125 | (delete-region pp (point)) | 5252 | (delete-region pp (point)) |
| 4126 | (insert | 5253 | (insert |
| 4127 | (make-string cperl-indent-region-fix-constructs ?\s)))) | 5254 | (make-string cperl-indent-region-fix-constructs ?\ ))) |
| 5255 | ((and (looking-at "[\t ]*{") | ||
| 5256 | (if ml cperl-extra-newline-before-brace-multiline | ||
| 5257 | cperl-extra-newline-before-brace)) | ||
| 5258 | (delete-horizontal-space) | ||
| 5259 | (insert "\n") | ||
| 5260 | (setq ret (point)) | ||
| 5261 | (if (cperl-indent-line parse-data) | ||
| 5262 | (progn | ||
| 5263 | (cperl-fix-line-spacing end parse-data) | ||
| 5264 | (setq ret (point)))))) | ||
| 4128 | ;; Now we are before `{' | 5265 | ;; Now we are before `{' |
| 4129 | (if (looking-at "[ \t\n]*{[ \t]*[^ \t\n#]") | 5266 | (if (looking-at "[ \t\n]*{[ \t]*[^ \t\n#]") |
| 4130 | (progn | 5267 | (progn |
| @@ -4276,7 +5413,7 @@ indentation and initial hashes. Behaves usually outside of comment." | |||
| 4276 | ;; (interactive "P") ; Only works when called from fill-paragraph. -stef | 5413 | ;; (interactive "P") ; Only works when called from fill-paragraph. -stef |
| 4277 | (let (;; Non-nil if the current line contains a comment. | 5414 | (let (;; Non-nil if the current line contains a comment. |
| 4278 | has-comment | 5415 | has-comment |
| 4279 | 5416 | fill-paragraph-function ; do not recurse | |
| 4280 | ;; If has-comment, the appropriate fill-prefix for the comment. | 5417 | ;; If has-comment, the appropriate fill-prefix for the comment. |
| 4281 | comment-fill-prefix | 5418 | comment-fill-prefix |
| 4282 | ;; Line that contains code and comment (or nil) | 5419 | ;; Line that contains code and comment (or nil) |
| @@ -4308,7 +5445,7 @@ indentation and initial hashes. Behaves usually outside of comment." | |||
| 4308 | dc (- c (current-column)) len (- start (point)) | 5445 | dc (- c (current-column)) len (- start (point)) |
| 4309 | start (point-marker)) | 5446 | start (point-marker)) |
| 4310 | (delete-char len) | 5447 | (delete-char len) |
| 4311 | (insert (make-string dc ?-))))) | 5448 | (insert (make-string dc ?-))))) ; Placeholder (to avoid splitting???) |
| 4312 | (if (not has-comment) | 5449 | (if (not has-comment) |
| 4313 | (fill-paragraph justify) ; Do the usual thing outside of comment | 5450 | (fill-paragraph justify) ; Do the usual thing outside of comment |
| 4314 | ;; Narrow to include only the comment, and then fill the region. | 5451 | ;; Narrow to include only the comment, and then fill the region. |
| @@ -4330,11 +5467,16 @@ indentation and initial hashes. Behaves usually outside of comment." | |||
| 4330 | (point))) | 5467 | (point))) |
| 4331 | ;; Remove existing hashes | 5468 | ;; Remove existing hashes |
| 4332 | (save-excursion | 5469 | (save-excursion |
| 4333 | (goto-char (point-min)) | 5470 | (goto-char (point-min)) |
| 4334 | (while (progn (forward-line 1) (< (point) (point-max))) | 5471 | (while (progn (forward-line 1) (< (point) (point-max))) |
| 4335 | (skip-chars-forward " \t") | 5472 | (skip-chars-forward " \t") |
| 4336 | (and (looking-at "#+") | 5473 | (if (looking-at "#+") |
| 4337 | (delete-char (- (match-end 0) (match-beginning 0)))))) | 5474 | (progn |
| 5475 | (if (and (eq (point) (match-beginning 0)) | ||
| 5476 | (not (eq (point) (match-end 0)))) nil | ||
| 5477 | (error | ||
| 5478 | "Bug in Emacs: `looking-at' in `narrow-to-region': match-data is garbage")) | ||
| 5479 | (delete-char (- (match-end 0) (match-beginning 0))))))) | ||
| 4338 | 5480 | ||
| 4339 | ;; Lines with only hashes on them can be paragraph boundaries. | 5481 | ;; Lines with only hashes on them can be paragraph boundaries. |
| 4340 | (let ((paragraph-start (concat paragraph-start "\\|^[ \t#]*$")) | 5482 | (let ((paragraph-start (concat paragraph-start "\\|^[ \t#]*$")) |
| @@ -4350,7 +5492,8 @@ indentation and initial hashes. Behaves usually outside of comment." | |||
| 4350 | (setq comment-column c) | 5492 | (setq comment-column c) |
| 4351 | (indent-for-comment) | 5493 | (indent-for-comment) |
| 4352 | ;; Repeat once more, flagging as iteration | 5494 | ;; Repeat once more, flagging as iteration |
| 4353 | (cperl-fill-paragraph justify t))))))) | 5495 | (cperl-fill-paragraph justify t)))))) |
| 5496 | t) | ||
| 4354 | 5497 | ||
| 4355 | (defun cperl-do-auto-fill () | 5498 | (defun cperl-do-auto-fill () |
| 4356 | ;; Break out if the line is short enough | 5499 | ;; Break out if the line is short enough |
| @@ -4401,8 +5544,8 @@ indentation and initial hashes. Behaves usually outside of comment." | |||
| 4401 | (let ((index-alist '()) (index-pack-alist '()) (index-pod-alist '()) | 5544 | (let ((index-alist '()) (index-pack-alist '()) (index-pod-alist '()) |
| 4402 | (index-unsorted-alist '()) (i-s-f (default-value 'imenu-sort-function)) | 5545 | (index-unsorted-alist '()) (i-s-f (default-value 'imenu-sort-function)) |
| 4403 | (index-meth-alist '()) meth | 5546 | (index-meth-alist '()) meth |
| 4404 | packages ends-ranges p marker | 5547 | packages ends-ranges p marker is-proto |
| 4405 | (prev-pos 0) char fchar index index1 name (end-range 0) package) | 5548 | (prev-pos 0) is-pack index index1 name (end-range 0) package) |
| 4406 | (goto-char (point-min)) | 5549 | (goto-char (point-min)) |
| 4407 | (cperl-update-syntaxification (point-max) (point-max)) | 5550 | (cperl-update-syntaxification (point-max) (point-max)) |
| 4408 | ;; Search for the function | 5551 | ;; Search for the function |
| @@ -4410,72 +5553,81 @@ indentation and initial hashes. Behaves usually outside of comment." | |||
| 4410 | (while (re-search-forward | 5553 | (while (re-search-forward |
| 4411 | (or regexp cperl-imenu--function-name-regexp-perl) | 5554 | (or regexp cperl-imenu--function-name-regexp-perl) |
| 4412 | nil t) | 5555 | nil t) |
| 5556 | ;; 2=package-group, 5=package-name 8=sub-name | ||
| 4413 | (cond | 5557 | (cond |
| 4414 | ((and ; Skip some noise if building tags | 5558 | ((and ; Skip some noise if building tags |
| 4415 | (match-beginning 2) ; package or sub | 5559 | (match-beginning 5) ; package name |
| 4416 | (eq (char-after (match-beginning 2)) ?p) ; package | 5560 | ;;(eq (char-after (match-beginning 2)) ?p) ; package |
| 4417 | (not (save-match-data | 5561 | (not (save-match-data |
| 4418 | (looking-at "[ \t\n]*;")))) ; Plain text word 'package' | 5562 | (looking-at "[ \t\n]*;")))) ; Plain text word 'package' |
| 4419 | nil) | 5563 | nil) |
| 4420 | ((and | 5564 | ((and |
| 4421 | (match-beginning 2) ; package or sub | 5565 | (or (match-beginning 2) |
| 5566 | (match-beginning 8)) ; package or sub | ||
| 4422 | ;; Skip if quoted (will not skip multi-line ''-strings :-(): | 5567 | ;; Skip if quoted (will not skip multi-line ''-strings :-(): |
| 4423 | (null (get-text-property (match-beginning 1) 'syntax-table)) | 5568 | (null (get-text-property (match-beginning 1) 'syntax-table)) |
| 4424 | (null (get-text-property (match-beginning 1) 'syntax-type)) | 5569 | (null (get-text-property (match-beginning 1) 'syntax-type)) |
| 4425 | (null (get-text-property (match-beginning 1) 'in-pod))) | 5570 | (null (get-text-property (match-beginning 1) 'in-pod))) |
| 4426 | (save-excursion | 5571 | (setq is-pack (match-beginning 2)) |
| 4427 | (goto-char (match-beginning 2)) | ||
| 4428 | (setq fchar (following-char))) | ||
| 4429 | ;; (if (looking-at "([^()]*)[ \t\n\f]*") | 5572 | ;; (if (looking-at "([^()]*)[ \t\n\f]*") |
| 4430 | ;; (goto-char (match-end 0))) ; Messes what follows | 5573 | ;; (goto-char (match-end 0))) ; Messes what follows |
| 4431 | (setq char (following-char) ; ?\; for "sub foo () ;" | 5574 | (setq meth nil |
| 4432 | meth nil | ||
| 4433 | p (point)) | 5575 | p (point)) |
| 4434 | (while (and ends-ranges (>= p (car ends-ranges))) | 5576 | (while (and ends-ranges (>= p (car ends-ranges))) |
| 4435 | ;; delete obsolete entries | 5577 | ;; delete obsolete entries |
| 4436 | (setq ends-ranges (cdr ends-ranges) packages (cdr packages))) | 5578 | (setq ends-ranges (cdr ends-ranges) packages (cdr packages))) |
| 4437 | (setq package (or (car packages) "") | 5579 | (setq package (or (car packages) "") |
| 4438 | end-range (or (car ends-ranges) 0)) | 5580 | end-range (or (car ends-ranges) 0)) |
| 4439 | (if (eq fchar ?p) | 5581 | (if is-pack ; doing "package" |
| 4440 | (setq name (buffer-substring (match-beginning 3) (match-end 3)) | 5582 | (progn |
| 4441 | name (progn | 5583 | (if (match-beginning 5) ; named package |
| 4442 | (set-text-properties 0 (length name) nil name) | 5584 | (setq name (buffer-substring (match-beginning 5) |
| 4443 | name) | 5585 | (match-end 5)) |
| 4444 | package (concat name "::") | 5586 | name (progn |
| 4445 | name (concat "package " name) | 5587 | (set-text-properties 0 (length name) nil name) |
| 4446 | end-range | 5588 | name) |
| 4447 | (save-excursion | 5589 | package (concat name "::") |
| 4448 | (parse-partial-sexp (point) (point-max) -1) (point)) | 5590 | name (concat "package " name)) |
| 4449 | ends-ranges (cons end-range ends-ranges) | 5591 | ;; Support nameless packages |
| 4450 | packages (cons package packages))) | 5592 | (setq name "package;" package "")) |
| 4451 | ;; ) | 5593 | (setq end-range |
| 5594 | (save-excursion | ||
| 5595 | (parse-partial-sexp (point) (point-max) -1) (point)) | ||
| 5596 | ends-ranges (cons end-range ends-ranges) | ||
| 5597 | packages (cons package packages))) | ||
| 5598 | (setq is-proto | ||
| 5599 | (or (eq (following-char) ?\;) | ||
| 5600 | (eq 0 (get-text-property (point) 'attrib-group))))) | ||
| 4452 | ;; Skip this function name if it is a prototype declaration. | 5601 | ;; Skip this function name if it is a prototype declaration. |
| 4453 | (if (and (eq fchar ?s) (eq char ?\;)) nil | 5602 | (if (and is-proto (not is-pack)) nil |
| 4454 | (setq name (buffer-substring (match-beginning 3) (match-end 3)) | 5603 | (or is-pack |
| 4455 | marker (make-marker)) | 5604 | (setq name |
| 4456 | (set-text-properties 0 (length name) nil name) | 5605 | (buffer-substring (match-beginning 8) (match-end 8))) |
| 4457 | (set-marker marker (match-end 3)) | 5606 | (set-text-properties 0 (length name) nil name)) |
| 4458 | (if (eq fchar ?p) | 5607 | (setq marker (make-marker)) |
| 4459 | (setq name (concat "package " name)) | 5608 | (set-marker marker (match-end (if is-pack 2 8))) |
| 4460 | (cond ((string-match "[:']" name) | 5609 | (cond (is-pack nil) |
| 4461 | (setq meth t)) | 5610 | ((string-match "[:']" name) |
| 4462 | ((> p end-range) nil) | 5611 | (setq meth t)) |
| 4463 | (t | 5612 | ((> p end-range) nil) |
| 4464 | (setq name (concat package name) meth t)))) | 5613 | (t |
| 5614 | (setq name (concat package name) meth t))) | ||
| 4465 | (setq index (cons name marker)) | 5615 | (setq index (cons name marker)) |
| 4466 | (if (eq fchar ?p) | 5616 | (if is-pack |
| 4467 | (push index index-pack-alist) | 5617 | (push index index-pack-alist) |
| 4468 | (push index index-alist)) | 5618 | (push index index-alist)) |
| 4469 | (if meth (push index index-meth-alist)) | 5619 | (if meth (push index index-meth-alist)) |
| 4470 | (push index index-unsorted-alist))) | 5620 | (push index index-unsorted-alist))) |
| 4471 | ((match-beginning 5) ; POD section | 5621 | ((match-beginning 16) ; POD section |
| 4472 | ;; (beginning-of-line) | 5622 | (setq name (buffer-substring (match-beginning 17) (match-end 17)) |
| 4473 | (setq index (imenu-example--name-and-position) | 5623 | marker (make-marker)) |
| 4474 | name (buffer-substring (match-beginning 6) (match-end 6))) | 5624 | (set-marker marker (match-beginning 17)) |
| 4475 | (set-text-properties 0 (length name) nil name) | 5625 | (set-text-properties 0 (length name) nil name) |
| 4476 | (if (eq (char-after (match-beginning 5)) ?2) | 5626 | (setq name (concat (make-string |
| 4477 | (setq name (concat " " name))) | 5627 | (* 3 (- (char-after (match-beginning 16)) ?1)) |
| 4478 | (setcar index name) | 5628 | ?\ ) |
| 5629 | name) | ||
| 5630 | index (cons name marker)) | ||
| 4479 | (setq index1 (cons (concat "=" name) (cdr index))) | 5631 | (setq index1 (cons (concat "=" name) (cdr index))) |
| 4480 | (push index index-pod-alist) | 5632 | (push index index-pod-alist) |
| 4481 | (push index1 index-unsorted-alist))))) | 5633 | (push index1 index-unsorted-alist))))) |
| @@ -4539,29 +5691,20 @@ indentation and initial hashes. Behaves usually outside of comment." | |||
| 4539 | (defun cperl-outline-level () | 5691 | (defun cperl-outline-level () |
| 4540 | (looking-at outline-regexp) | 5692 | (looking-at outline-regexp) |
| 4541 | (cond ((not (match-beginning 1)) 0) ; beginning-of-file | 5693 | (cond ((not (match-beginning 1)) 0) ; beginning-of-file |
| 4542 | ((match-beginning 2) | 5694 | ;;;; 2=package-group, 5=package-name 8=sub-name 16=head-level |
| 4543 | (if (eq (char-after (match-beginning 2)) ?p) | 5695 | ((match-beginning 2) 0) ; package |
| 4544 | 0 ; package | 5696 | ((match-beginning 8) 1) ; sub |
| 4545 | 1)) ; sub | 5697 | ((match-beginning 16) |
| 4546 | ((match-beginning 5) | 5698 | (- (char-after (match-beginning 16)) ?0)) ; headN ==> N |
| 4547 | (if (eq (char-after (match-beginning 5)) ?1) | 5699 | (t 5))) ; should not happen |
| 4548 | 1 ; head1 | ||
| 4549 | 2)) ; head2 | ||
| 4550 | (t 3))) ; should not happen | ||
| 4551 | 5700 | ||
| 4552 | 5701 | ||
| 4553 | (defvar cperl-compilation-error-regexp-alist | 5702 | (defvar cperl-compilation-error-regexp-alist |
| 4554 | ;; This look like a paranoiac regexp: could anybody find a better one? (which WORK). | 5703 | ;; This look like a paranoiac regexp: could anybody find a better one? (which WORKS). |
| 4555 | '(("^[^\n]* \\(file\\|at\\) \\([^ \t\n]+\\) [^\n]*line \\([0-9]+\\)[\\., \n]" | 5704 | '(("^[^\n]* \\(file\\|at\\) \\([^ \t\n]+\\) [^\n]*line \\([0-9]+\\)[\\., \n]" |
| 4556 | 2 3)) | 5705 | 2 3)) |
| 4557 | "Alist that specifies how to match errors in perl output.") | 5706 | "Alist that specifies how to match errors in perl output.") |
| 4558 | 5707 | ||
| 4559 | (if (fboundp 'eval-after-load) | ||
| 4560 | (eval-after-load | ||
| 4561 | "mode-compile" | ||
| 4562 | '(setq perl-compilation-error-regexp-alist | ||
| 4563 | cperl-compilation-error-regexp-alist))) | ||
| 4564 | |||
| 4565 | 5708 | ||
| 4566 | (defun cperl-windowed-init () | 5709 | (defun cperl-windowed-init () |
| 4567 | "Initialization under windowed version." | 5710 | "Initialization under windowed version." |
| @@ -4602,9 +5745,12 @@ indentation and initial hashes. Behaves usually outside of comment." | |||
| 4602 | ;; Allow `cperl-find-pods-heres' to run. | 5745 | ;; Allow `cperl-find-pods-heres' to run. |
| 4603 | (or (boundp 'font-lock-constant-face) | 5746 | (or (boundp 'font-lock-constant-face) |
| 4604 | (cperl-force-face font-lock-constant-face | 5747 | (cperl-force-face font-lock-constant-face |
| 4605 | "Face for constant and label names") | 5748 | "Face for constant and label names")) |
| 4606 | ;;(setq font-lock-constant-face 'font-lock-constant-face) | 5749 | (or (boundp 'font-lock-warning-face) |
| 4607 | )) | 5750 | (cperl-force-face font-lock-warning-face |
| 5751 | "Face for things which should stand out")) | ||
| 5752 | ;;(setq font-lock-constant-face 'font-lock-constant-face) | ||
| 5753 | ) | ||
| 4608 | 5754 | ||
| 4609 | (defun cperl-init-faces () | 5755 | (defun cperl-init-faces () |
| 4610 | (condition-case errs | 5756 | (condition-case errs |
| @@ -4627,7 +5773,7 @@ indentation and initial hashes. Behaves usually outside of comment." | |||
| 4627 | 'identity | 5773 | 'identity |
| 4628 | '("if" "until" "while" "elsif" "else" "unless" "for" | 5774 | '("if" "until" "while" "elsif" "else" "unless" "for" |
| 4629 | "foreach" "continue" "exit" "die" "last" "goto" "next" | 5775 | "foreach" "continue" "exit" "die" "last" "goto" "next" |
| 4630 | "redo" "return" "local" "exec" "sub" "do" "dump" "use" | 5776 | "redo" "return" "local" "exec" "sub" "do" "dump" "use" "our" |
| 4631 | "require" "package" "eval" "my" "BEGIN" "END" "CHECK" "INIT") | 5777 | "require" "package" "eval" "my" "BEGIN" "END" "CHECK" "INIT") |
| 4632 | "\\|") ; Flow control | 5778 | "\\|") ; Flow control |
| 4633 | "\\)\\>") 2) ; was "\\)[ \n\t;():,\|&]" | 5779 | "\\)\\>") 2) ; was "\\)[ \n\t;():,\|&]" |
| @@ -4711,7 +5857,7 @@ indentation and initial hashes. Behaves usually outside of comment." | |||
| 4711 | ;; "chop" "defined" "delete" "do" "each" "else" "elsif" | 5857 | ;; "chop" "defined" "delete" "do" "each" "else" "elsif" |
| 4712 | ;; "eval" "exists" "for" "foreach" "format" "goto" | 5858 | ;; "eval" "exists" "for" "foreach" "format" "goto" |
| 4713 | ;; "grep" "if" "keys" "last" "local" "map" "my" "next" | 5859 | ;; "grep" "if" "keys" "last" "local" "map" "my" "next" |
| 4714 | ;; "no" "package" "pop" "pos" "print" "printf" "push" | 5860 | ;; "no" "our" "package" "pop" "pos" "print" "printf" "push" |
| 4715 | ;; "q" "qq" "qw" "qx" "redo" "return" "scalar" "shift" | 5861 | ;; "q" "qq" "qw" "qx" "redo" "return" "scalar" "shift" |
| 4716 | ;; "sort" "splice" "split" "study" "sub" "tie" "tr" | 5862 | ;; "sort" "splice" "split" "study" "sub" "tie" "tr" |
| 4717 | ;; "undef" "unless" "unshift" "untie" "until" "use" | 5863 | ;; "undef" "unless" "unshift" "untie" "until" "use" |
| @@ -4726,15 +5872,38 @@ indentation and initial hashes. Behaves usually outside of comment." | |||
| 4726 | "u\\(se\\|n\\(shift\\|ti\\(l\\|e\\)\\|def\\|less\\)\\)\\|" | 5872 | "u\\(se\\|n\\(shift\\|ti\\(l\\|e\\)\\|def\\|less\\)\\)\\|" |
| 4727 | "while\\|y\\|__\\(END\\|DATA\\)__" ;__DATA__ added manually | 5873 | "while\\|y\\|__\\(END\\|DATA\\)__" ;__DATA__ added manually |
| 4728 | "\\|[sm]" ; Added manually | 5874 | "\\|[sm]" ; Added manually |
| 4729 | "\\)\\>") 2 'cperl-nonoverridable) | 5875 | "\\)\\>") 2 'cperl-nonoverridable-face) |
| 4730 | ;; (mapconcat 'identity | 5876 | ;; (mapconcat 'identity |
| 4731 | ;; '("#endif" "#else" "#ifdef" "#ifndef" "#if" | 5877 | ;; '("#endif" "#else" "#ifdef" "#ifndef" "#if" |
| 4732 | ;; "#include" "#define" "#undef") | 5878 | ;; "#include" "#define" "#undef") |
| 4733 | ;; "\\|") | 5879 | ;; "\\|") |
| 4734 | '("-[rwxoRWXOezsfdlpSbctugkTBMAC]\\>\\([ \t]+_\\>\\)?" 0 | 5880 | '("-[rwxoRWXOezsfdlpSbctugkTBMAC]\\>\\([ \t]+_\\>\\)?" 0 |
| 4735 | font-lock-function-name-face keep) ; Not very good, triggers at "[a-z]" | 5881 | font-lock-function-name-face keep) ; Not very good, triggers at "[a-z]" |
| 4736 | '("\\<sub[ \t]+\\([^ \t{;()]+\\)[ \t]*\\(([^()]*)[ \t]*\\)?[#{\n]" 1 | 5882 | ;; This highlights declarations and definitions differenty. |
| 4737 | font-lock-function-name-face) | 5883 | ;; We do not try to highlight in the case of attributes: |
| 5884 | ;; it is already done by `cperl-find-pods-heres' | ||
| 5885 | (list (concat "\\<sub" | ||
| 5886 | cperl-white-and-comment-rex ; whitespace/comments | ||
| 5887 | "\\([^ \n\t{;()]+\\)" ; 2=name (assume non-anonymous) | ||
| 5888 | "\\(" | ||
| 5889 | cperl-maybe-white-and-comment-rex ;whitespace/comments? | ||
| 5890 | "([^()]*)\\)?" ; prototype | ||
| 5891 | cperl-maybe-white-and-comment-rex ; whitespace/comments? | ||
| 5892 | "[{;]") | ||
| 5893 | 2 (if cperl-font-lock-multiline | ||
| 5894 | '(if (eq (char-after (cperl-1- (match-end 0))) ?\{ ) | ||
| 5895 | 'font-lock-function-name-face | ||
| 5896 | 'font-lock-variable-name-face) | ||
| 5897 | ;; need to manually set 'multiline' for older font-locks | ||
| 5898 | '(progn | ||
| 5899 | (if (< 1 (count-lines (match-beginning 0) | ||
| 5900 | (match-end 0))) | ||
| 5901 | (put-text-property | ||
| 5902 | (+ 3 (match-beginning 0)) (match-end 0) | ||
| 5903 | 'syntax-type 'multiline)) | ||
| 5904 | (if (eq (char-after (cperl-1- (match-end 0))) ?\{ ) | ||
| 5905 | 'font-lock-function-name-face | ||
| 5906 | 'font-lock-variable-name-face)))) | ||
| 4738 | '("\\<\\(package\\|require\\|use\\|import\\|no\\|bootstrap\\)[ \t]+\\([a-zA-z_][a-zA-z_0-9:]*\\)[ \t;]" ; require A if B; | 5907 | '("\\<\\(package\\|require\\|use\\|import\\|no\\|bootstrap\\)[ \t]+\\([a-zA-z_][a-zA-z_0-9:]*\\)[ \t;]" ; require A if B; |
| 4739 | 2 font-lock-function-name-face) | 5908 | 2 font-lock-function-name-face) |
| 4740 | '("^[ \t]*format[ \t]+\\([a-zA-z_][a-zA-z_0-9:]*\\)[ \t]*=[ \t]*$" | 5909 | '("^[ \t]*format[ \t]+\\([a-zA-z_][a-zA-z_0-9:]*\\)[ \t]*=[ \t]*$" |
| @@ -4770,12 +5939,56 @@ indentation and initial hashes. Behaves usually outside of comment." | |||
| 4770 | (2 '(restart 2 nil) nil t))) | 5939 | (2 '(restart 2 nil) nil t))) |
| 4771 | nil t))) ; local variables, multiple | 5940 | nil t))) ; local variables, multiple |
| 4772 | (font-lock-anchored | 5941 | (font-lock-anchored |
| 4773 | '("^[ \t{}]*\\(my\\|local\\|our\\)[ \t]*\\(([ \t]*\\)?\\([$@%*][a-zA-Z0-9_:]+\\)" | 5942 | ;; 1=my_etc, 2=white? 3=(+white? 4=white? 5=var |
| 4774 | (3 font-lock-variable-name-face) | 5943 | (` ((, (concat "\\<\\(my\\|local\\|our\\)" |
| 4775 | ("\\=[ \t]*,[ \t]*\\([$@%*][a-zA-Z0-9_:]+\\)" | 5944 | cperl-maybe-white-and-comment-rex |
| 4776 | nil nil | 5945 | "\\((" |
| 4777 | (1 font-lock-variable-name-face)))) | 5946 | cperl-maybe-white-and-comment-rex |
| 4778 | (t '("^[ \t{}]*\\(my\\|local\\our\\)[ \t]*\\(([ \t]*\\)?\\([$@%*][a-zA-Z0-9_:]+\\)" | 5947 | "\\)?\\([$@%*]\\([a-zA-Z0-9_:]+\\|[^a-zA-Z0-9_]\\)\\)")) |
| 5948 | (5 (, (if cperl-font-lock-multiline | ||
| 5949 | 'font-lock-variable-name-face | ||
| 5950 | '(progn (setq cperl-font-lock-multiline-start | ||
| 5951 | (match-beginning 0)) | ||
| 5952 | 'font-lock-variable-name-face)))) | ||
| 5953 | ((, (concat "\\=" | ||
| 5954 | cperl-maybe-white-and-comment-rex | ||
| 5955 | "," | ||
| 5956 | cperl-maybe-white-and-comment-rex | ||
| 5957 | "\\([$@%*]\\([a-zA-Z0-9_:]+\\|[^a-zA-Z0-9_]\\)\\)")) | ||
| 5958 | ;; Bug in font-lock: limit is used not only to limit | ||
| 5959 | ;; searches, but to set the "extend window for | ||
| 5960 | ;; facification" property. Thus we need to minimize. | ||
| 5961 | (, (if cperl-font-lock-multiline | ||
| 5962 | '(if (match-beginning 3) | ||
| 5963 | (save-excursion | ||
| 5964 | (goto-char (match-beginning 3)) | ||
| 5965 | (condition-case nil | ||
| 5966 | (forward-sexp 1) | ||
| 5967 | (error | ||
| 5968 | (condition-case nil | ||
| 5969 | (forward-char 200) | ||
| 5970 | (error nil)))) ; typeahead | ||
| 5971 | (1- (point))) ; report limit | ||
| 5972 | (forward-char -2)) ; disable continued expr | ||
| 5973 | '(if (match-beginning 3) | ||
| 5974 | (point-max) ; No limit for continuation | ||
| 5975 | (forward-char -2)))) ; disable continued expr | ||
| 5976 | (, (if cperl-font-lock-multiline | ||
| 5977 | nil | ||
| 5978 | '(progn ; Do at end | ||
| 5979 | ;; "my" may be already fontified (POD), | ||
| 5980 | ;; so cperl-font-lock-multiline-start is nil | ||
| 5981 | (if (or (not cperl-font-lock-multiline-start) | ||
| 5982 | (> 2 (count-lines | ||
| 5983 | cperl-font-lock-multiline-start | ||
| 5984 | (point)))) | ||
| 5985 | nil | ||
| 5986 | (put-text-property | ||
| 5987 | (1+ cperl-font-lock-multiline-start) (point) | ||
| 5988 | 'syntax-type 'multiline)) | ||
| 5989 | (setq cperl-font-lock-multiline-start nil)))) | ||
| 5990 | (3 font-lock-variable-name-face))))) | ||
| 5991 | (t '("^[ \t{}]*\\(my\\|local\\|our\\)[ \t]*\\(([ \t]*\\)?\\([$@%*][a-zA-Z0-9_:]+\\)" | ||
| 4779 | 3 font-lock-variable-name-face))) | 5992 | 3 font-lock-variable-name-face))) |
| 4780 | '("\\<for\\(each\\)?\\([ \t]+\\(my\\|local\\|our\\)\\)?[ \t]*\\(\\$[a-zA-Z_][a-zA-Z_0-9]*\\)[ \t]*(" | 5993 | '("\\<for\\(each\\)?\\([ \t]+\\(my\\|local\\|our\\)\\)?[ \t]*\\(\\$[a-zA-Z_][a-zA-Z_0-9]*\\)[ \t]*(" |
| 4781 | 4 font-lock-variable-name-face) | 5994 | 4 font-lock-variable-name-face) |
| @@ -4785,21 +5998,32 @@ indentation and initial hashes. Behaves usually outside of comment." | |||
| 4785 | (setq | 5998 | (setq |
| 4786 | t-font-lock-keywords-1 | 5999 | t-font-lock-keywords-1 |
| 4787 | (and (fboundp 'turn-on-font-lock) ; Check for newer font-lock | 6000 | (and (fboundp 'turn-on-font-lock) ; Check for newer font-lock |
| 4788 | (not cperl-xemacs-p) ; not yet as of XEmacs 19.12 | 6001 | ;; not yet as of XEmacs 19.12, works with 21.1.11 |
| 6002 | (or | ||
| 6003 | (not cperl-xemacs-p) | ||
| 6004 | (string< "21.1.9" emacs-version) | ||
| 6005 | (and (string< "21.1.10" emacs-version) | ||
| 6006 | (string< emacs-version "21.1.2"))) | ||
| 4789 | '( | 6007 | '( |
| 4790 | ("\\(\\([@%]\\|\$#\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)" 1 | 6008 | ("\\(\\([@%]\\|\$#\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)" 1 |
| 4791 | (if (eq (char-after (match-beginning 2)) ?%) | 6009 | (if (eq (char-after (match-beginning 2)) ?%) |
| 4792 | 'cperl-hash | 6010 | 'cperl-hash-face |
| 4793 | 'cperl-array) | 6011 | 'cperl-array-face) |
| 4794 | t) ; arrays and hashes | 6012 | t) ; arrays and hashes |
| 4795 | ("\\(\\([$@]+\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)[ \t]*\\([[{]\\)" | 6013 | ("\\(\\([$@]+\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)[ \t]*\\([[{]\\)" |
| 4796 | 1 | 6014 | 1 |
| 4797 | (if (= (- (match-end 2) (match-beginning 2)) 1) | 6015 | (if (= (- (match-end 2) (match-beginning 2)) 1) |
| 4798 | (if (eq (char-after (match-beginning 3)) ?{) | 6016 | (if (eq (char-after (match-beginning 3)) ?{) |
| 4799 | 'cperl-hash | 6017 | 'cperl-hash-face |
| 4800 | 'cperl-array) ; arrays and hashes | 6018 | 'cperl-array-face) ; arrays and hashes |
| 4801 | font-lock-variable-name-face) ; Just to put something | 6019 | font-lock-variable-name-face) ; Just to put something |
| 4802 | t) | 6020 | t) |
| 6021 | ("\\(@\\|\\$#\\)\\(\\$+\\([a-zA-Z_:][a-zA-Z0-9_:]*\\|[^ \t\n]\\)\\)" | ||
| 6022 | (1 cperl-array-face) | ||
| 6023 | (2 font-lock-variable-name-face)) | ||
| 6024 | ("\\(%\\)\\(\\$+\\([a-zA-Z_:][a-zA-Z0-9_:]*\\|[^ \t\n]\\)\\)" | ||
| 6025 | (1 cperl-hash-face) | ||
| 6026 | (2 font-lock-variable-name-face)) | ||
| 4803 | ;;("\\([smy]\\|tr\\)\\([^a-z_A-Z0-9]\\)\\(\\([^\n\\]*||\\)\\)\\2") | 6027 | ;;("\\([smy]\\|tr\\)\\([^a-z_A-Z0-9]\\)\\(\\([^\n\\]*||\\)\\)\\2") |
| 4804 | ;;; Too much noise from \s* @s[ and friends | 6028 | ;;; Too much noise from \s* @s[ and friends |
| 4805 | ;;("\\(\\<\\([msy]\\|tr\\)[ \t]*\\([^ \t\na-zA-Z0-9_]\\)\\|\\(/\\)\\)" | 6029 | ;;("\\(\\<\\([msy]\\|tr\\)[ \t]*\\([^ \t\na-zA-Z0-9_]\\)\\|\\(/\\)\\)" |
| @@ -4811,7 +6035,7 @@ indentation and initial hashes. Behaves usually outside of comment." | |||
| 4811 | (if cperl-highlight-variables-indiscriminately | 6035 | (if cperl-highlight-variables-indiscriminately |
| 4812 | (setq t-font-lock-keywords-1 | 6036 | (setq t-font-lock-keywords-1 |
| 4813 | (append t-font-lock-keywords-1 | 6037 | (append t-font-lock-keywords-1 |
| 4814 | (list '("[$*]{?\\(\\sw+\\)" 1 | 6038 | (list '("\\([$*]{?\\sw+\\)" 1 |
| 4815 | font-lock-variable-name-face))))) | 6039 | font-lock-variable-name-face))))) |
| 4816 | (setq cperl-font-lock-keywords-1 | 6040 | (setq cperl-font-lock-keywords-1 |
| 4817 | (if cperl-syntaxify-by-font-lock | 6041 | (if cperl-syntaxify-by-font-lock |
| @@ -4864,27 +6088,35 @@ indentation and initial hashes. Behaves usually outside of comment." | |||
| 4864 | [nil nil t t t] | 6088 | [nil nil t t t] |
| 4865 | nil | 6089 | nil |
| 4866 | [nil nil t t t]) | 6090 | [nil nil t t t]) |
| 6091 | (list 'font-lock-warning-face | ||
| 6092 | ["Pink" "Red" "Gray50" "LightGray"] | ||
| 6093 | ["gray20" "gray90" | ||
| 6094 | "gray80" "gray20"] | ||
| 6095 | [nil nil t t t] | ||
| 6096 | nil | ||
| 6097 | [nil nil t t t] | ||
| 6098 | ) | ||
| 4867 | (list 'font-lock-constant-face | 6099 | (list 'font-lock-constant-face |
| 4868 | ["CadetBlue" "Aquamarine" "Gray50" "LightGray"] | 6100 | ["CadetBlue" "Aquamarine" "Gray50" "LightGray"] |
| 4869 | nil | 6101 | nil |
| 4870 | [nil nil t t t] | 6102 | [nil nil t t t] |
| 4871 | nil | 6103 | nil |
| 4872 | [nil nil t t t]) | 6104 | [nil nil t t t]) |
| 4873 | (list 'cperl-nonoverridable | 6105 | (list 'cperl-nonoverridable-face |
| 4874 | ["chartreuse3" ("orchid1" "orange") | 6106 | ["chartreuse3" ("orchid1" "orange") |
| 4875 | nil "Gray80"] | 6107 | nil "Gray80"] |
| 4876 | [nil nil "gray90"] | 6108 | [nil nil "gray90"] |
| 4877 | [nil nil nil t t] | 6109 | [nil nil nil t t] |
| 4878 | [nil nil t t] | 6110 | [nil nil t t] |
| 4879 | [nil nil t t t]) | 6111 | [nil nil t t t]) |
| 4880 | (list 'cperl-array | 6112 | (list 'cperl-array-face |
| 4881 | ["blue" "yellow" nil "Gray80"] | 6113 | ["blue" "yellow" nil "Gray80"] |
| 4882 | ["lightyellow2" ("navy" "os2blue" "darkgreen") | 6114 | ["lightyellow2" ("navy" "os2blue" "darkgreen") |
| 4883 | "gray90"] | 6115 | "gray90"] |
| 4884 | t | 6116 | t |
| 4885 | nil | 6117 | nil |
| 4886 | nil) | 6118 | nil) |
| 4887 | (list 'cperl-hash | 6119 | (list 'cperl-hash-face |
| 4888 | ["red" "red" nil "Gray80"] | 6120 | ["red" "red" nil "Gray80"] |
| 4889 | ["lightyellow2" ("navy" "os2blue" "darkgreen") | 6121 | ["lightyellow2" ("navy" "os2blue" "darkgreen") |
| 4890 | "gray90"] | 6122 | "gray90"] |
| @@ -4907,15 +6139,17 @@ indentation and initial hashes. Behaves usually outside of comment." | |||
| 4907 | "Face for variable names") | 6139 | "Face for variable names") |
| 4908 | (cperl-force-face font-lock-type-face | 6140 | (cperl-force-face font-lock-type-face |
| 4909 | "Face for data types") | 6141 | "Face for data types") |
| 4910 | (cperl-force-face cperl-nonoverridable | 6142 | (cperl-force-face cperl-nonoverridable-face |
| 4911 | "Face for data types from another group") | 6143 | "Face for data types from another group") |
| 6144 | (cperl-force-face font-lock-warning-face | ||
| 6145 | "Face for things which should stand out") | ||
| 4912 | (cperl-force-face font-lock-comment-face | 6146 | (cperl-force-face font-lock-comment-face |
| 4913 | "Face for comments") | 6147 | "Face for comments") |
| 4914 | (cperl-force-face font-lock-function-name-face | 6148 | (cperl-force-face font-lock-function-name-face |
| 4915 | "Face for function names") | 6149 | "Face for function names") |
| 4916 | (cperl-force-face cperl-hash | 6150 | (cperl-force-face cperl-hash-face |
| 4917 | "Face for hashes") | 6151 | "Face for hashes") |
| 4918 | (cperl-force-face cperl-array | 6152 | (cperl-force-face cperl-array-face |
| 4919 | "Face for arrays") | 6153 | "Face for arrays") |
| 4920 | ;;(defvar font-lock-constant-face 'font-lock-constant-face) | 6154 | ;;(defvar font-lock-constant-face 'font-lock-constant-face) |
| 4921 | ;;(defvar font-lock-variable-name-face 'font-lock-variable-name-face) | 6155 | ;;(defvar font-lock-variable-name-face 'font-lock-variable-name-face) |
| @@ -4925,7 +6159,7 @@ indentation and initial hashes. Behaves usually outside of comment." | |||
| 4925 | ;; "Face to use for data types.")) | 6159 | ;; "Face to use for data types.")) |
| 4926 | ;;(or (boundp 'cperl-nonoverridable-face) | 6160 | ;;(or (boundp 'cperl-nonoverridable-face) |
| 4927 | ;; (defconst cperl-nonoverridable-face | 6161 | ;; (defconst cperl-nonoverridable-face |
| 4928 | ;; 'cperl-nonoverridable | 6162 | ;; 'cperl-nonoverridable-face |
| 4929 | ;; "Face to use for data types from another group.")) | 6163 | ;; "Face to use for data types from another group.")) |
| 4930 | ;;(if (not cperl-xemacs-p) nil | 6164 | ;;(if (not cperl-xemacs-p) nil |
| 4931 | ;; (or (boundp 'font-lock-comment-face) | 6165 | ;; (or (boundp 'font-lock-comment-face) |
| @@ -4941,24 +6175,24 @@ indentation and initial hashes. Behaves usually outside of comment." | |||
| 4941 | ;; 'font-lock-function-name-face | 6175 | ;; 'font-lock-function-name-face |
| 4942 | ;; "Face to use for function names."))) | 6176 | ;; "Face to use for function names."))) |
| 4943 | (if (and | 6177 | (if (and |
| 4944 | (not (cperl-is-face 'cperl-array)) | 6178 | (not (cperl-is-face 'cperl-array-face)) |
| 4945 | (cperl-is-face 'font-lock-emphasized-face)) | 6179 | (cperl-is-face 'font-lock-emphasized-face)) |
| 4946 | (copy-face 'font-lock-emphasized-face 'cperl-array)) | 6180 | (copy-face 'font-lock-emphasized-face 'cperl-array-face)) |
| 4947 | (if (and | 6181 | (if (and |
| 4948 | (not (cperl-is-face 'cperl-hash)) | 6182 | (not (cperl-is-face 'cperl-hash-face)) |
| 4949 | (cperl-is-face 'font-lock-other-emphasized-face)) | 6183 | (cperl-is-face 'font-lock-other-emphasized-face)) |
| 4950 | (copy-face 'font-lock-other-emphasized-face 'cperl-hash)) | 6184 | (copy-face 'font-lock-other-emphasized-face 'cperl-hash-face)) |
| 4951 | (if (and | 6185 | (if (and |
| 4952 | (not (cperl-is-face 'cperl-nonoverridable)) | 6186 | (not (cperl-is-face 'cperl-nonoverridable-face)) |
| 4953 | (cperl-is-face 'font-lock-other-type-face)) | 6187 | (cperl-is-face 'font-lock-other-type-face)) |
| 4954 | (copy-face 'font-lock-other-type-face 'cperl-nonoverridable)) | 6188 | (copy-face 'font-lock-other-type-face 'cperl-nonoverridable-face)) |
| 4955 | ;;(or (boundp 'cperl-hash-face) | 6189 | ;;(or (boundp 'cperl-hash-face) |
| 4956 | ;; (defconst cperl-hash-face | 6190 | ;; (defconst cperl-hash-face |
| 4957 | ;; 'cperl-hash | 6191 | ;; 'cperl-hash-face |
| 4958 | ;; "Face to use for hashes.")) | 6192 | ;; "Face to use for hashes.")) |
| 4959 | ;;(or (boundp 'cperl-array-face) | 6193 | ;;(or (boundp 'cperl-array-face) |
| 4960 | ;; (defconst cperl-array-face | 6194 | ;; (defconst cperl-array-face |
| 4961 | ;; 'cperl-array | 6195 | ;; 'cperl-array-face |
| 4962 | ;; "Face to use for arrays.")) | 6196 | ;; "Face to use for arrays.")) |
| 4963 | ;; Here we try to guess background | 6197 | ;; Here we try to guess background |
| 4964 | (let ((background | 6198 | (let ((background |
| @@ -4997,17 +6231,17 @@ indentation and initial hashes. Behaves usually outside of comment." | |||
| 4997 | "pink"))) | 6231 | "pink"))) |
| 4998 | (t | 6232 | (t |
| 4999 | (set-face-background 'font-lock-type-face "gray90")))) | 6233 | (set-face-background 'font-lock-type-face "gray90")))) |
| 5000 | (if (cperl-is-face 'cperl-nonoverridable) | 6234 | (if (cperl-is-face 'cperl-nonoverridable-face) |
| 5001 | nil | 6235 | nil |
| 5002 | (copy-face 'font-lock-type-face 'cperl-nonoverridable) | 6236 | (copy-face 'font-lock-type-face 'cperl-nonoverridable-face) |
| 5003 | (cond | 6237 | (cond |
| 5004 | ((eq background 'light) | 6238 | ((eq background 'light) |
| 5005 | (set-face-foreground 'cperl-nonoverridable | 6239 | (set-face-foreground 'cperl-nonoverridable-face |
| 5006 | (if (x-color-defined-p "chartreuse3") | 6240 | (if (x-color-defined-p "chartreuse3") |
| 5007 | "chartreuse3" | 6241 | "chartreuse3" |
| 5008 | "chartreuse"))) | 6242 | "chartreuse"))) |
| 5009 | ((eq background 'dark) | 6243 | ((eq background 'dark) |
| 5010 | (set-face-foreground 'cperl-nonoverridable | 6244 | (set-face-foreground 'cperl-nonoverridable-face |
| 5011 | (if (x-color-defined-p "orchid1") | 6245 | (if (x-color-defined-p "orchid1") |
| 5012 | "orchid1" | 6246 | "orchid1" |
| 5013 | "orange"))))) | 6247 | "orange"))))) |
| @@ -5059,15 +6293,15 @@ indentation and initial hashes. Behaves usually outside of comment." | |||
| 5059 | '(setq ps-bold-faces | 6293 | '(setq ps-bold-faces |
| 5060 | ;; font-lock-variable-name-face | 6294 | ;; font-lock-variable-name-face |
| 5061 | ;; font-lock-constant-face | 6295 | ;; font-lock-constant-face |
| 5062 | (append '(cperl-array cperl-hash) | 6296 | (append '(cperl-array-face cperl-hash-face) |
| 5063 | ps-bold-faces) | 6297 | ps-bold-faces) |
| 5064 | ps-italic-faces | 6298 | ps-italic-faces |
| 5065 | ;; font-lock-constant-face | 6299 | ;; font-lock-constant-face |
| 5066 | (append '(cperl-nonoverridable cperl-hash) | 6300 | (append '(cperl-nonoverridable-face cperl-hash-face) |
| 5067 | ps-italic-faces) | 6301 | ps-italic-faces) |
| 5068 | ps-underlined-faces | 6302 | ps-underlined-faces |
| 5069 | ;; font-lock-type-face | 6303 | ;; font-lock-type-face |
| 5070 | (append '(cperl-array cperl-hash underline cperl-nonoverridable) | 6304 | (append '(cperl-array-face cperl-hash-face underline cperl-nonoverridable-face) |
| 5071 | ps-underlined-faces)))) | 6305 | ps-underlined-faces)))) |
| 5072 | 6306 | ||
| 5073 | (defvar ps-print-face-extension-alist) | 6307 | (defvar ps-print-face-extension-alist) |
| @@ -5100,27 +6334,27 @@ Style of printout regulated by the variable `cperl-ps-print-face-properties'." | |||
| 5100 | ;;; (defvar ps-italic-faces nil) | 6334 | ;;; (defvar ps-italic-faces nil) |
| 5101 | ;;; (setq ps-bold-faces | 6335 | ;;; (setq ps-bold-faces |
| 5102 | ;;; (append '(font-lock-emphasized-face | 6336 | ;;; (append '(font-lock-emphasized-face |
| 5103 | ;;; cperl-array | 6337 | ;;; cperl-array-face |
| 5104 | ;;; font-lock-keyword-face | 6338 | ;;; font-lock-keyword-face |
| 5105 | ;;; font-lock-variable-name-face | 6339 | ;;; font-lock-variable-name-face |
| 5106 | ;;; font-lock-constant-face | 6340 | ;;; font-lock-constant-face |
| 5107 | ;;; font-lock-reference-face | 6341 | ;;; font-lock-reference-face |
| 5108 | ;;; font-lock-other-emphasized-face | 6342 | ;;; font-lock-other-emphasized-face |
| 5109 | ;;; cperl-hash) | 6343 | ;;; cperl-hash-face) |
| 5110 | ;;; ps-bold-faces)) | 6344 | ;;; ps-bold-faces)) |
| 5111 | ;;; (setq ps-italic-faces | 6345 | ;;; (setq ps-italic-faces |
| 5112 | ;;; (append '(cperl-nonoverridable | 6346 | ;;; (append '(cperl-nonoverridable-face |
| 5113 | ;;; font-lock-constant-face | 6347 | ;;; font-lock-constant-face |
| 5114 | ;;; font-lock-reference-face | 6348 | ;;; font-lock-reference-face |
| 5115 | ;;; font-lock-other-emphasized-face | 6349 | ;;; font-lock-other-emphasized-face |
| 5116 | ;;; cperl-hash) | 6350 | ;;; cperl-hash-face) |
| 5117 | ;;; ps-italic-faces)) | 6351 | ;;; ps-italic-faces)) |
| 5118 | ;;; (setq ps-underlined-faces | 6352 | ;;; (setq ps-underlined-faces |
| 5119 | ;;; (append '(font-lock-emphasized-face | 6353 | ;;; (append '(font-lock-emphasized-face |
| 5120 | ;;; cperl-array | 6354 | ;;; cperl-array-face |
| 5121 | ;;; font-lock-other-emphasized-face | 6355 | ;;; font-lock-other-emphasized-face |
| 5122 | ;;; cperl-hash | 6356 | ;;; cperl-hash-face |
| 5123 | ;;; cperl-nonoverridable font-lock-type-face) | 6357 | ;;; cperl-nonoverridable-face font-lock-type-face) |
| 5124 | ;;; ps-underlined-faces)) | 6358 | ;;; ps-underlined-faces)) |
| 5125 | ;;; (cons 'font-lock-type-face ps-underlined-faces)) | 6359 | ;;; (cons 'font-lock-type-face ps-underlined-faces)) |
| 5126 | 6360 | ||
| @@ -5130,79 +6364,211 @@ Style of printout regulated by the variable `cperl-ps-print-face-properties'." | |||
| 5130 | (defconst cperl-styles-entries | 6364 | (defconst cperl-styles-entries |
| 5131 | '(cperl-indent-level cperl-brace-offset cperl-continued-brace-offset | 6365 | '(cperl-indent-level cperl-brace-offset cperl-continued-brace-offset |
| 5132 | cperl-label-offset cperl-extra-newline-before-brace | 6366 | cperl-label-offset cperl-extra-newline-before-brace |
| 6367 | cperl-extra-newline-before-brace-multiline | ||
| 5133 | cperl-merge-trailing-else | 6368 | cperl-merge-trailing-else |
| 5134 | cperl-continued-statement-offset)) | 6369 | cperl-continued-statement-offset)) |
| 5135 | 6370 | ||
| 6371 | (defconst cperl-style-examples | ||
| 6372 | "##### Numbers etc are: cperl-indent-level cperl-brace-offset | ||
| 6373 | ##### cperl-continued-brace-offset cperl-label-offset | ||
| 6374 | ##### cperl-continued-statement-offset | ||
| 6375 | ##### cperl-merge-trailing-else cperl-extra-newline-before-brace | ||
| 6376 | |||
| 6377 | ########### (Do not forget cperl-extra-newline-before-brace-multiline) | ||
| 6378 | |||
| 6379 | ### CPerl (=GNU - extra-newline-before-brace + merge-trailing-else) 2/0/0/-2/2/t/nil | ||
| 6380 | if (foo) { | ||
| 6381 | bar | ||
| 6382 | baz; | ||
| 6383 | label: | ||
| 6384 | { | ||
| 6385 | boon; | ||
| 6386 | } | ||
| 6387 | } else { | ||
| 6388 | stop; | ||
| 6389 | } | ||
| 6390 | |||
| 6391 | ### PerlStyle (=CPerl with 4 as indent) 4/0/0/-4/4/t/nil | ||
| 6392 | if (foo) { | ||
| 6393 | bar | ||
| 6394 | baz; | ||
| 6395 | label: | ||
| 6396 | { | ||
| 6397 | boon; | ||
| 6398 | } | ||
| 6399 | } else { | ||
| 6400 | stop; | ||
| 6401 | } | ||
| 6402 | |||
| 6403 | ### GNU 2/0/0/-2/2/nil/t | ||
| 6404 | if (foo) | ||
| 6405 | { | ||
| 6406 | bar | ||
| 6407 | baz; | ||
| 6408 | label: | ||
| 6409 | { | ||
| 6410 | boon; | ||
| 6411 | } | ||
| 6412 | } | ||
| 6413 | else | ||
| 6414 | { | ||
| 6415 | stop; | ||
| 6416 | } | ||
| 6417 | |||
| 6418 | ### C++ (=PerlStyle with braces aligned with control words) 4/0/-4/-4/4/nil/t | ||
| 6419 | if (foo) | ||
| 6420 | { | ||
| 6421 | bar | ||
| 6422 | baz; | ||
| 6423 | label: | ||
| 6424 | { | ||
| 6425 | boon; | ||
| 6426 | } | ||
| 6427 | } | ||
| 6428 | else | ||
| 6429 | { | ||
| 6430 | stop; | ||
| 6431 | } | ||
| 6432 | |||
| 6433 | ### BSD (=C++, but will not change preexisting merge-trailing-else | ||
| 6434 | ### and extra-newline-before-brace ) 4/0/-4/-4/4 | ||
| 6435 | if (foo) | ||
| 6436 | { | ||
| 6437 | bar | ||
| 6438 | baz; | ||
| 6439 | label: | ||
| 6440 | { | ||
| 6441 | boon; | ||
| 6442 | } | ||
| 6443 | } | ||
| 6444 | else | ||
| 6445 | { | ||
| 6446 | stop; | ||
| 6447 | } | ||
| 6448 | |||
| 6449 | ### K&R (=C++ with indent 5 - merge-trailing-else, but will not | ||
| 6450 | ### change preexisting extra-newline-before-brace) 5/0/-5/-5/5/nil | ||
| 6451 | if (foo) | ||
| 6452 | { | ||
| 6453 | bar | ||
| 6454 | baz; | ||
| 6455 | label: | ||
| 6456 | { | ||
| 6457 | boon; | ||
| 6458 | } | ||
| 6459 | } | ||
| 6460 | else | ||
| 6461 | { | ||
| 6462 | stop; | ||
| 6463 | } | ||
| 6464 | |||
| 6465 | ### Whitesmith (=PerlStyle, but will not change preexisting | ||
| 6466 | ### extra-newline-before-brace and merge-trailing-else) 4/0/0/-4/4 | ||
| 6467 | if (foo) | ||
| 6468 | { | ||
| 6469 | bar | ||
| 6470 | baz; | ||
| 6471 | label: | ||
| 6472 | { | ||
| 6473 | boon; | ||
| 6474 | } | ||
| 6475 | } | ||
| 6476 | else | ||
| 6477 | { | ||
| 6478 | stop; | ||
| 6479 | } | ||
| 6480 | " | ||
| 6481 | "Examples of if/else with different indent styles (with v4.23).") | ||
| 6482 | |||
| 5136 | (defconst cperl-style-alist | 6483 | (defconst cperl-style-alist |
| 5137 | '(("CPerl" ; =GNU without extra-newline-before-brace | 6484 | '(("CPerl" ;; =GNU - extra-newline-before-brace + cperl-merge-trailing-else |
| 5138 | (cperl-indent-level . 2) | 6485 | (cperl-indent-level . 2) |
| 5139 | (cperl-brace-offset . 0) | 6486 | (cperl-brace-offset . 0) |
| 5140 | (cperl-continued-brace-offset . 0) | 6487 | (cperl-continued-brace-offset . 0) |
| 5141 | (cperl-label-offset . -2) | 6488 | (cperl-label-offset . -2) |
| 6489 | (cperl-continued-statement-offset . 2) | ||
| 5142 | (cperl-extra-newline-before-brace . nil) | 6490 | (cperl-extra-newline-before-brace . nil) |
| 5143 | (cperl-merge-trailing-else . t) | 6491 | (cperl-extra-newline-before-brace-multiline . nil) |
| 5144 | (cperl-continued-statement-offset . 2)) | 6492 | (cperl-merge-trailing-else . t)) |
| 6493 | |||
| 5145 | ("PerlStyle" ; CPerl with 4 as indent | 6494 | ("PerlStyle" ; CPerl with 4 as indent |
| 5146 | (cperl-indent-level . 4) | 6495 | (cperl-indent-level . 4) |
| 5147 | (cperl-brace-offset . 0) | 6496 | (cperl-brace-offset . 0) |
| 5148 | (cperl-continued-brace-offset . 0) | 6497 | (cperl-continued-brace-offset . 0) |
| 5149 | (cperl-label-offset . -4) | 6498 | (cperl-label-offset . -4) |
| 6499 | (cperl-continued-statement-offset . 4) | ||
| 5150 | (cperl-extra-newline-before-brace . nil) | 6500 | (cperl-extra-newline-before-brace . nil) |
| 5151 | (cperl-merge-trailing-else . t) | 6501 | (cperl-extra-newline-before-brace-multiline . nil) |
| 5152 | (cperl-continued-statement-offset . 4)) | 6502 | (cperl-merge-trailing-else . t)) |
| 6503 | |||
| 5153 | ("GNU" | 6504 | ("GNU" |
| 5154 | (cperl-indent-level . 2) | 6505 | (cperl-indent-level . 2) |
| 5155 | (cperl-brace-offset . 0) | 6506 | (cperl-brace-offset . 0) |
| 5156 | (cperl-continued-brace-offset . 0) | 6507 | (cperl-continued-brace-offset . 0) |
| 5157 | (cperl-label-offset . -2) | 6508 | (cperl-label-offset . -2) |
| 6509 | (cperl-continued-statement-offset . 2) | ||
| 5158 | (cperl-extra-newline-before-brace . t) | 6510 | (cperl-extra-newline-before-brace . t) |
| 5159 | (cperl-merge-trailing-else . nil) | 6511 | (cperl-extra-newline-before-brace-multiline . t) |
| 5160 | (cperl-continued-statement-offset . 2)) | 6512 | (cperl-merge-trailing-else . nil)) |
| 6513 | |||
| 5161 | ("K&R" | 6514 | ("K&R" |
| 5162 | (cperl-indent-level . 5) | 6515 | (cperl-indent-level . 5) |
| 5163 | (cperl-brace-offset . 0) | 6516 | (cperl-brace-offset . 0) |
| 5164 | (cperl-continued-brace-offset . -5) | 6517 | (cperl-continued-brace-offset . -5) |
| 5165 | (cperl-label-offset . -5) | 6518 | (cperl-label-offset . -5) |
| 6519 | (cperl-continued-statement-offset . 5) | ||
| 5166 | ;;(cperl-extra-newline-before-brace . nil) ; ??? | 6520 | ;;(cperl-extra-newline-before-brace . nil) ; ??? |
| 5167 | (cperl-merge-trailing-else . nil) | 6521 | ;;(cperl-extra-newline-before-brace-multiline . nil) |
| 5168 | (cperl-continued-statement-offset . 5)) | 6522 | (cperl-merge-trailing-else . nil)) |
| 6523 | |||
| 5169 | ("BSD" | 6524 | ("BSD" |
| 5170 | (cperl-indent-level . 4) | 6525 | (cperl-indent-level . 4) |
| 5171 | (cperl-brace-offset . 0) | 6526 | (cperl-brace-offset . 0) |
| 5172 | (cperl-continued-brace-offset . -4) | 6527 | (cperl-continued-brace-offset . -4) |
| 5173 | (cperl-label-offset . -4) | 6528 | (cperl-label-offset . -4) |
| 6529 | (cperl-continued-statement-offset . 4) | ||
| 5174 | ;;(cperl-extra-newline-before-brace . nil) ; ??? | 6530 | ;;(cperl-extra-newline-before-brace . nil) ; ??? |
| 5175 | (cperl-continued-statement-offset . 4)) | 6531 | ;;(cperl-extra-newline-before-brace-multiline . nil) |
| 6532 | ;;(cperl-merge-trailing-else . nil) ; ??? | ||
| 6533 | ) | ||
| 6534 | |||
| 5176 | ("C++" | 6535 | ("C++" |
| 5177 | (cperl-indent-level . 4) | 6536 | (cperl-indent-level . 4) |
| 5178 | (cperl-brace-offset . 0) | 6537 | (cperl-brace-offset . 0) |
| 5179 | (cperl-continued-brace-offset . -4) | 6538 | (cperl-continued-brace-offset . -4) |
| 5180 | (cperl-label-offset . -4) | 6539 | (cperl-label-offset . -4) |
| 5181 | (cperl-continued-statement-offset . 4) | 6540 | (cperl-continued-statement-offset . 4) |
| 5182 | (cperl-merge-trailing-else . nil) | 6541 | (cperl-extra-newline-before-brace . t) |
| 5183 | (cperl-extra-newline-before-brace . t)) | 6542 | (cperl-extra-newline-before-brace-multiline . t) |
| 5184 | ("Current") | 6543 | (cperl-merge-trailing-else . nil)) |
| 6544 | |||
| 5185 | ("Whitesmith" | 6545 | ("Whitesmith" |
| 5186 | (cperl-indent-level . 4) | 6546 | (cperl-indent-level . 4) |
| 5187 | (cperl-brace-offset . 0) | 6547 | (cperl-brace-offset . 0) |
| 5188 | (cperl-continued-brace-offset . 0) | 6548 | (cperl-continued-brace-offset . 0) |
| 5189 | (cperl-label-offset . -4) | 6549 | (cperl-label-offset . -4) |
| 6550 | (cperl-continued-statement-offset . 4) | ||
| 5190 | ;;(cperl-extra-newline-before-brace . nil) ; ??? | 6551 | ;;(cperl-extra-newline-before-brace . nil) ; ??? |
| 5191 | (cperl-continued-statement-offset . 4))) | 6552 | ;;(cperl-extra-newline-before-brace-multiline . nil) |
| 5192 | "(Experimental) list of variables to set to get a particular indentation style. | 6553 | ;;(cperl-merge-trailing-else . nil) ; ??? |
| 5193 | Should be used via `cperl-set-style' or via Perl menu.") | 6554 | ) |
| 6555 | ("Current")) | ||
| 6556 | "List of variables to set to get a particular indentation style. | ||
| 6557 | Should be used via `cperl-set-style' or via Perl menu. | ||
| 6558 | |||
| 6559 | See examples in `cperl-style-examples'.") | ||
| 5194 | 6560 | ||
| 5195 | (defun cperl-set-style (style) | 6561 | (defun cperl-set-style (style) |
| 5196 | "Set CPerl mode variables to use one of several different indentation styles. | 6562 | "Set CPerl mode variables to use one of several different indentation styles. |
| 5197 | The arguments are a string representing the desired style. | 6563 | The arguments are a string representing the desired style. |
| 5198 | The list of styles is in `cperl-style-alist', available styles | 6564 | The list of styles is in `cperl-style-alist', available styles |
| 5199 | are GNU, K&R, BSD, C++ and Whitesmith. | 6565 | are CPerl, PerlStyle, GNU, K&R, BSD, C++ and Whitesmith. |
| 5200 | 6566 | ||
| 5201 | The current value of style is memorized (unless there is a memorized | 6567 | The current value of style is memorized (unless there is a memorized |
| 5202 | data already), may be restored by `cperl-set-style-back'. | 6568 | data already), may be restored by `cperl-set-style-back'. |
| 5203 | 6569 | ||
| 5204 | Chosing \"Current\" style will not change style, so this may be used for | 6570 | Chosing \"Current\" style will not change style, so this may be used for |
| 5205 | side-effect of memorizing only." | 6571 | side-effect of memorizing only. Examples in `cperl-style-examples'." |
| 5206 | (interactive | 6572 | (interactive |
| 5207 | (let ((list (mapcar (function (lambda (elt) (list (car elt)))) | 6573 | (let ((list (mapcar (function (lambda (elt) (list (car elt)))) |
| 5208 | cperl-style-alist))) | 6574 | cperl-style-alist))) |
| @@ -5373,6 +6739,8 @@ Customized by setting variables `cperl-shrink-wrap-info-frame', | |||
| 5373 | (match-beginning 1) (match-end 1))) | 6739 | (match-beginning 1) (match-end 1))) |
| 5374 | 6740 | ||
| 5375 | (defun cperl-imenu-on-info () | 6741 | (defun cperl-imenu-on-info () |
| 6742 | "Shows imenu for Perl Info Buffer. | ||
| 6743 | Opens Perl Info buffer if needed." | ||
| 5376 | (interactive) | 6744 | (interactive) |
| 5377 | (let* ((buffer (current-buffer)) | 6745 | (let* ((buffer (current-buffer)) |
| 5378 | imenu-create-index-function | 6746 | imenu-create-index-function |
| @@ -5412,7 +6780,7 @@ If STEP is nil, `cperl-lineup-step' will be used | |||
| 5412 | \(or `cperl-indent-level', if `cperl-lineup-step' is nil). | 6780 | \(or `cperl-indent-level', if `cperl-lineup-step' is nil). |
| 5413 | Will not move the position at the start to the left." | 6781 | Will not move the position at the start to the left." |
| 5414 | (interactive "r") | 6782 | (interactive "r") |
| 5415 | (let (search col tcol seen b e) | 6783 | (let (search col tcol seen b) |
| 5416 | (save-excursion | 6784 | (save-excursion |
| 5417 | (goto-char end) | 6785 | (goto-char end) |
| 5418 | (end-of-line) | 6786 | (end-of-line) |
| @@ -5450,22 +6818,25 @@ Will not move the position at the start to the left." | |||
| 5450 | (if (/= (% col step) 0) (setq step (* step (1+ (/ col step))))) | 6818 | (if (/= (% col step) 0) (setq step (* step (1+ (/ col step))))) |
| 5451 | (while | 6819 | (while |
| 5452 | (progn | 6820 | (progn |
| 5453 | (setq e (point)) | 6821 | (cperl-make-indent col) |
| 5454 | (skip-chars-backward " \t") | ||
| 5455 | (delete-region (point) e) | ||
| 5456 | (indent-to-column col) ;(make-string (- col (current-column)) ?\s)) | ||
| 5457 | (beginning-of-line 2) | 6822 | (beginning-of-line 2) |
| 5458 | (and (< (point) end) | 6823 | (and (< (point) end) |
| 5459 | (re-search-forward search end t) | 6824 | (re-search-forward search end t) |
| 5460 | (goto-char (match-beginning 0)))))))) ; No body | 6825 | (goto-char (match-beginning 0)))))))) ; No body |
| 5461 | 6826 | ||
| 5462 | (defun cperl-etags (&optional add all files) | 6827 | (defun cperl-etags (&optional add all files) ;; NOT USED??? |
| 5463 | "Run etags with appropriate options for Perl files. | 6828 | "Run etags with appropriate options for Perl files. |
| 5464 | If optional argument ALL is `recursive', will process Perl files | 6829 | If optional argument ALL is `recursive', will process Perl files |
| 5465 | in subdirectories too." | 6830 | in subdirectories too." |
| 5466 | (interactive) | 6831 | (interactive) |
| 5467 | (let ((cmd "etags") | 6832 | (let ((cmd "etags") |
| 5468 | (args '("-l" "none" "-r" "/\\<\\(package\\|sub\\)[ \\t]+\\(\\([a-zA-Z0-9:_]*::\\)?\\([a-zA-Z0-9_]+\\)[ \\t]*\\(([^()]*)[ \t]*\\)?\\([{#]\\|$\\)\\)/\\4/")) | 6833 | (args '("-l" "none" "-r" |
| 6834 | ;; 1=fullname 2=package? 3=name 4=proto? 5=attrs? (VERY APPROX!) | ||
| 6835 | "/\\<sub[ \\t]+\\(\\([a-zA-Z0-9:_]*::\\)?\\([a-zA-Z0-9_]+\\)\\)[ \\t]*\\(([^()]*)[ \t]*\\)?\\([ \t]*:[^#{;]*\\)?\\([{#]\\|$\\)/\\3/" | ||
| 6836 | "-r" | ||
| 6837 | "/\\<package[ \\t]+\\(\\([a-zA-Z0-9:_]*::\\)?\\([a-zA-Z0-9_]+\\)\\)[ \\t]*\\([#;]\\|$\\)/\\1/" | ||
| 6838 | "-r" | ||
| 6839 | "/\\<\\(package\\)[ \\t]*;/\\1;/")) | ||
| 5469 | res) | 6840 | res) |
| 5470 | (if add (setq args (cons "-a" args))) | 6841 | (if add (setq args (cons "-a" args))) |
| 5471 | (or files (setq files (list buffer-file-name))) | 6842 | (or files (setq files (list buffer-file-name))) |
| @@ -5537,6 +6908,29 @@ Delay of auto-help controlled by `cperl-lazy-help-time'." | |||
| 5537 | (message "indent-region/indent-sexp will %sbe automatically fix whitespace." | 6908 | (message "indent-region/indent-sexp will %sbe automatically fix whitespace." |
| 5538 | (if cperl-indent-region-fix-constructs "" "not "))) | 6909 | (if cperl-indent-region-fix-constructs "" "not "))) |
| 5539 | 6910 | ||
| 6911 | (defun cperl-toggle-set-debug-unwind (arg &optional backtrace) | ||
| 6912 | "Toggle (or, with numeric argument, set) debugging state of syntaxification. | ||
| 6913 | Nonpositive numeric argument disables debugging messages. The message | ||
| 6914 | summarizes which regions it was decided to rescan for syntactic constructs. | ||
| 6915 | |||
| 6916 | The message looks like this: | ||
| 6917 | |||
| 6918 | Syxify req=123..138 actual=101..146 done-to: 112=>146 statepos: 73=>117 | ||
| 6919 | |||
| 6920 | Numbers are character positions in the buffer. REQ provides the range to | ||
| 6921 | rescan requested by `font-lock'. ACTUAL is the range actually resyntaxified; | ||
| 6922 | for correct operation it should start and end outside any special syntactic | ||
| 6923 | construct. DONE-TO and STATEPOS indicate changes to internal caches maintained | ||
| 6924 | by CPerl." | ||
| 6925 | (interactive "P") | ||
| 6926 | (or arg | ||
| 6927 | (setq arg (if (eq cperl-syntaxify-by-font-lock | ||
| 6928 | (if backtrace 'backtrace 'message)) 0 1))) | ||
| 6929 | (setq arg (if (> arg 0) (if backtrace 'backtrace 'message) t)) | ||
| 6930 | (setq cperl-syntaxify-by-font-lock arg) | ||
| 6931 | (message "Debugging messages of syntax unwind %sabled." | ||
| 6932 | (if (eq arg t) "dis" "en"))) | ||
| 6933 | |||
| 5540 | ;;;; Tags file creation. | 6934 | ;;;; Tags file creation. |
| 5541 | 6935 | ||
| 5542 | (defvar cperl-tmp-buffer " *cperl-tmp*") | 6936 | (defvar cperl-tmp-buffer " *cperl-tmp*") |
| @@ -5677,13 +7071,22 @@ Delay of auto-help controlled by `cperl-lazy-help-time'." | |||
| 5677 | ret)))) | 7071 | ret)))) |
| 5678 | 7072 | ||
| 5679 | (defun cperl-add-tags-recurse-noxs () | 7073 | (defun cperl-add-tags-recurse-noxs () |
| 5680 | "Add to TAGS data for Perl and XSUB files in the current directory and kids. | 7074 | "Add to TAGS data for \"pure\" Perl files in the current directory and kids. |
| 5681 | Use as | 7075 | Use as |
| 5682 | emacs -batch -q -no-site-file -l emacs/cperl-mode.el \ | 7076 | emacs -batch -q -no-site-file -l emacs/cperl-mode.el \ |
| 5683 | -f cperl-add-tags-recurse | 7077 | -f cperl-add-tags-recurse-noxs |
| 5684 | " | 7078 | " |
| 5685 | (cperl-write-tags nil nil t t nil t)) | 7079 | (cperl-write-tags nil nil t t nil t)) |
| 5686 | 7080 | ||
| 7081 | (defun cperl-add-tags-recurse-noxs-fullpath () | ||
| 7082 | "Add to TAGS data for \"pure\" Perl in the current directory and kids. | ||
| 7083 | Writes down fullpath, so TAGS is relocatable (but if the build directory | ||
| 7084 | is relocated, the file TAGS inside it breaks). Use as | ||
| 7085 | emacs -batch -q -no-site-file -l emacs/cperl-mode.el \ | ||
| 7086 | -f cperl-add-tags-recurse-noxs-fullpath | ||
| 7087 | " | ||
| 7088 | (cperl-write-tags nil nil t t nil t "")) | ||
| 7089 | |||
| 5687 | (defun cperl-add-tags-recurse () | 7090 | (defun cperl-add-tags-recurse () |
| 5688 | "Add to TAGS file data for Perl files in the current directory and kids. | 7091 | "Add to TAGS file data for Perl files in the current directory and kids. |
| 5689 | Use as | 7092 | Use as |
| @@ -5853,9 +7256,9 @@ One may build such TAGS files from CPerl mode menu." | |||
| 5853 | (cperl-tags-hier-fill)) | 7256 | (cperl-tags-hier-fill)) |
| 5854 | (or tags-table-list | 7257 | (or tags-table-list |
| 5855 | (call-interactively 'visit-tags-table)) | 7258 | (call-interactively 'visit-tags-table)) |
| 5856 | (mapcar | 7259 | (mapcar |
| 5857 | (function | 7260 | (function |
| 5858 | (lambda (tagsfile) | 7261 | (lambda (tagsfile) |
| 5859 | (message "Updating list of classes... %s" tagsfile) | 7262 | (message "Updating list of classes... %s" tagsfile) |
| 5860 | (set-buffer (get-file-buffer tagsfile)) | 7263 | (set-buffer (get-file-buffer tagsfile)) |
| 5861 | (cperl-tags-hier-fill))) | 7264 | (cperl-tags-hier-fill))) |
| @@ -6017,7 +7420,7 @@ One may build such TAGS files from CPerl mode menu." | |||
| 6017 | '("[^-\t <>=+]\\(--\\|\\+\\+\\)" ; var-- var++ | 7420 | '("[^-\t <>=+]\\(--\\|\\+\\+\\)" ; var-- var++ |
| 6018 | "[a-zA-Z0-9_][|&][a-zA-Z0-9_$]" ; abc|def abc&def are often used. | 7421 | "[a-zA-Z0-9_][|&][a-zA-Z0-9_$]" ; abc|def abc&def are often used. |
| 6019 | "&[(a-zA-Z0-9_$]" ; &subroutine &(var->field) | 7422 | "&[(a-zA-Z0-9_$]" ; &subroutine &(var->field) |
| 6020 | "<\\$?\\sw+\\(\\.\\sw+\\)?>" ; <IN> <stdin.h> | 7423 | "<\\$?\\sw+\\(\\.\\(\\sw\\|_\\)+\\)?>" ; <IN> <stdin.h> |
| 6021 | "-[a-zA-Z][ \t]+[_$\"'`a-zA-Z]" ; -f file, -t STDIN | 7424 | "-[a-zA-Z][ \t]+[_$\"'`a-zA-Z]" ; -f file, -t STDIN |
| 6022 | "-[0-9]" ; -5 | 7425 | "-[0-9]" ; -5 |
| 6023 | "\\+\\+" ; ++var | 7426 | "\\+\\+" ; ++var |
| @@ -6049,8 +7452,7 @@ Currently it is tuned to C and Perl syntax." | |||
| 6049 | (interactive) | 7452 | (interactive) |
| 6050 | (let (found-bad (p (point))) | 7453 | (let (found-bad (p (point))) |
| 6051 | (setq last-nonmenu-event 13) ; To disable popup | 7454 | (setq last-nonmenu-event 13) ; To disable popup |
| 6052 | (with-no-warnings ; It is useful to push the mark here. | 7455 | (goto-char (point-min)) |
| 6053 | (beginning-of-buffer)) | ||
| 6054 | (map-y-or-n-p "Insert space here? " | 7456 | (map-y-or-n-p "Insert space here? " |
| 6055 | (lambda (arg) (insert " ")) | 7457 | (lambda (arg) (insert " ")) |
| 6056 | 'cperl-next-bad-style | 7458 | 'cperl-next-bad-style |
| @@ -6446,7 +7848,7 @@ endservent | |||
| 6446 | eof[([FILEHANDLE])] | 7848 | eof[([FILEHANDLE])] |
| 6447 | ... eq ... String equality. | 7849 | ... eq ... String equality. |
| 6448 | eval(EXPR) or eval { BLOCK } | 7850 | eval(EXPR) or eval { BLOCK } |
| 6449 | exec(LIST) | 7851 | exec([TRUENAME] ARGV0, ARGVs) or exec(SHELL_COMMAND_LINE) |
| 6450 | exit(EXPR) | 7852 | exit(EXPR) |
| 6451 | exp(EXPR) | 7853 | exp(EXPR) |
| 6452 | fcntl(FILEHANDLE,FUNCTION,SCALAR) | 7854 | fcntl(FILEHANDLE,FUNCTION,SCALAR) |
| @@ -6582,7 +7984,7 @@ substr(EXPR,OFFSET[,LEN]) | |||
| 6582 | symlink(OLDFILE,NEWFILE) | 7984 | symlink(OLDFILE,NEWFILE) |
| 6583 | syscall(LIST) | 7985 | syscall(LIST) |
| 6584 | sysread(FILEHANDLE,SCALAR,LENGTH[,OFFSET]) | 7986 | sysread(FILEHANDLE,SCALAR,LENGTH[,OFFSET]) |
| 6585 | system(LIST) | 7987 | system([TRUENAME] ARGV0 [,ARGV]) or system(SHELL_COMMAND_LINE) |
| 6586 | syswrite(FILEHANDLE,SCALAR,LENGTH[,OFFSET]) | 7988 | syswrite(FILEHANDLE,SCALAR,LENGTH[,OFFSET]) |
| 6587 | tell[(FILEHANDLE)] | 7989 | tell[(FILEHANDLE)] |
| 6588 | telldir(DIRHANDLE) | 7990 | telldir(DIRHANDLE) |
| @@ -6683,7 +8085,7 @@ prototype \\&SUB Returns prototype of the function given a reference. | |||
| 6683 | ;; b is before the starting delimiter, e before the ending | 8085 | ;; b is before the starting delimiter, e before the ending |
| 6684 | ;; e should be a marker, may be changed, but remains "correct". | 8086 | ;; e should be a marker, may be changed, but remains "correct". |
| 6685 | ;; EMBED is nil iff we process the whole REx. | 8087 | ;; EMBED is nil iff we process the whole REx. |
| 6686 | ;; The REx is guarantied to have //x | 8088 | ;; The REx is guaranteed to have //x |
| 6687 | ;; LEVEL shows how many levels deep to go | 8089 | ;; LEVEL shows how many levels deep to go |
| 6688 | ;; position at enter and at leave is not defined | 8090 | ;; position at enter and at leave is not defined |
| 6689 | (let (s c tmp (m (make-marker)) (m1 (make-marker)) c1 spaces inline code pos) | 8091 | (let (s c tmp (m (make-marker)) (m1 (make-marker)) c1 spaces inline code pos) |
| @@ -6712,7 +8114,7 @@ prototype \\&SUB Returns prototype of the function given a reference. | |||
| 6712 | (goto-char e) | 8114 | (goto-char e) |
| 6713 | (delete-horizontal-space) | 8115 | (delete-horizontal-space) |
| 6714 | (insert "\n") | 8116 | (insert "\n") |
| 6715 | (indent-to-column c) | 8117 | (cperl-make-indent c) |
| 6716 | (set-marker e (point)))) | 8118 | (set-marker e (point)))) |
| 6717 | (goto-char b) | 8119 | (goto-char b) |
| 6718 | (end-of-line 2) | 8120 | (end-of-line 2) |
| @@ -6722,7 +8124,7 @@ prototype \\&SUB Returns prototype of the function given a reference. | |||
| 6722 | inline t) | 8124 | inline t) |
| 6723 | (skip-chars-forward " \t") | 8125 | (skip-chars-forward " \t") |
| 6724 | (delete-region s (point)) | 8126 | (delete-region s (point)) |
| 6725 | (indent-to-column c1) | 8127 | (cperl-make-indent c1) |
| 6726 | (while (and | 8128 | (while (and |
| 6727 | inline | 8129 | inline |
| 6728 | (looking-at | 8130 | (looking-at |
| @@ -6748,6 +8150,16 @@ prototype \\&SUB Returns prototype of the function given a reference. | |||
| 6748 | (eq (preceding-char) ?\{))) | 8150 | (eq (preceding-char) ?\{))) |
| 6749 | (forward-char -1) | 8151 | (forward-char -1) |
| 6750 | (forward-sexp 1)) | 8152 | (forward-sexp 1)) |
| 8153 | ((and ; [], already syntaxified | ||
| 8154 | (match-beginning 6) | ||
| 8155 | cperl-regexp-scan | ||
| 8156 | cperl-use-syntax-table-text-property) | ||
| 8157 | (forward-char -1) | ||
| 8158 | (forward-sexp 1) | ||
| 8159 | (or (eq (preceding-char) ?\]) | ||
| 8160 | (error "[]-group not terminated")) | ||
| 8161 | (re-search-forward | ||
| 8162 | "\\=\\([*+?]\\|{[0-9]+\\(,[0-9]*\\)?}\\)\\??" e t)) | ||
| 6751 | ((match-beginning 6) ; [] | 8163 | ((match-beginning 6) ; [] |
| 6752 | (setq tmp (point)) | 8164 | (setq tmp (point)) |
| 6753 | (if (looking-at "\\^?\\]") | 8165 | (if (looking-at "\\^?\\]") |
| @@ -6761,12 +8173,8 @@ prototype \\&SUB Returns prototype of the function given a reference. | |||
| 6761 | (setq pos t))) | 8173 | (setq pos t))) |
| 6762 | (or (eq (preceding-char) ?\]) | 8174 | (or (eq (preceding-char) ?\]) |
| 6763 | (error "[]-group not terminated")) | 8175 | (error "[]-group not terminated")) |
| 6764 | (if (eq (following-char) ?\{) | 8176 | (re-search-forward |
| 6765 | (progn | 8177 | "\\=\\([*+?]\\|{[0-9]+\\(,[0-9]*\\)?}\\)\\??" e t)) |
| 6766 | (forward-sexp 1) | ||
| 6767 | (and (eq (following-char) ??) | ||
| 6768 | (forward-char 1))) | ||
| 6769 | (re-search-forward "\\=\\([*+?]\\??\\)" e t))) | ||
| 6770 | ((match-beginning 7) ; () | 8178 | ((match-beginning 7) ; () |
| 6771 | (goto-char (match-beginning 0)) | 8179 | (goto-char (match-beginning 0)) |
| 6772 | (setq pos (current-column)) | 8180 | (setq pos (current-column)) |
| @@ -6774,7 +8182,7 @@ prototype \\&SUB Returns prototype of the function given a reference. | |||
| 6774 | (progn | 8182 | (progn |
| 6775 | (delete-horizontal-space) | 8183 | (delete-horizontal-space) |
| 6776 | (insert "\n") | 8184 | (insert "\n") |
| 6777 | (indent-to-column c1))) | 8185 | (cperl-make-indent c1))) |
| 6778 | (setq tmp (point)) | 8186 | (setq tmp (point)) |
| 6779 | (forward-sexp 1) | 8187 | (forward-sexp 1) |
| 6780 | ;; (or (forward-sexp 1) | 8188 | ;; (or (forward-sexp 1) |
| @@ -6834,7 +8242,7 @@ prototype \\&SUB Returns prototype of the function given a reference. | |||
| 6834 | (insert "\n")) | 8242 | (insert "\n")) |
| 6835 | ;; first at line | 8243 | ;; first at line |
| 6836 | (delete-region (point) tmp)) | 8244 | (delete-region (point) tmp)) |
| 6837 | (indent-to-column c) | 8245 | (cperl-make-indent c) |
| 6838 | (forward-char 1) | 8246 | (forward-char 1) |
| 6839 | (skip-chars-forward " \t") | 8247 | (skip-chars-forward " \t") |
| 6840 | (setq spaces nil) | 8248 | (setq spaces nil) |
| @@ -6857,10 +8265,7 @@ prototype \\&SUB Returns prototype of the function given a reference. | |||
| 6857 | (/= (current-indentation) c)) | 8265 | (/= (current-indentation) c)) |
| 6858 | (progn | 8266 | (progn |
| 6859 | (beginning-of-line) | 8267 | (beginning-of-line) |
| 6860 | (setq s (point)) | 8268 | (cperl-make-indent c))))) |
| 6861 | (skip-chars-forward " \t") | ||
| 6862 | (delete-region s (point)) | ||
| 6863 | (indent-to-column c))))) | ||
| 6864 | 8269 | ||
| 6865 | (defun cperl-make-regexp-x () | 8270 | (defun cperl-make-regexp-x () |
| 6866 | ;; Returns position of the start | 8271 | ;; Returns position of the start |
| @@ -6929,7 +8334,7 @@ We suppose that the regexp is scanned already." | |||
| 6929 | (interactive) | 8334 | (interactive) |
| 6930 | ;; (save-excursion ; Can't, breaks `cperl-contract-levels' | 8335 | ;; (save-excursion ; Can't, breaks `cperl-contract-levels' |
| 6931 | (cperl-regext-to-level-start) | 8336 | (cperl-regext-to-level-start) |
| 6932 | (let ((b (point)) (e (make-marker)) s c) | 8337 | (let ((b (point)) (e (make-marker)) c) |
| 6933 | (forward-sexp 1) | 8338 | (forward-sexp 1) |
| 6934 | (set-marker e (1- (point))) | 8339 | (set-marker e (1- (point))) |
| 6935 | (goto-char b) | 8340 | (goto-char b) |
| @@ -6938,10 +8343,7 @@ We suppose that the regexp is scanned already." | |||
| 6938 | ((match-beginning 1) ; #-comment | 8343 | ((match-beginning 1) ; #-comment |
| 6939 | (or c (setq c (current-indentation))) | 8344 | (or c (setq c (current-indentation))) |
| 6940 | (beginning-of-line 2) ; Skip | 8345 | (beginning-of-line 2) ; Skip |
| 6941 | (setq s (point)) | 8346 | (cperl-make-indent c)) |
| 6942 | (skip-chars-forward " \t") | ||
| 6943 | (delete-region s (point)) | ||
| 6944 | (indent-to-column c)) | ||
| 6945 | (t | 8347 | (t |
| 6946 | (delete-char -1) | 8348 | (delete-char -1) |
| 6947 | (just-one-space)))))) | 8349 | (just-one-space)))))) |
| @@ -6980,96 +8382,197 @@ We suppose that the regexp is scanned already." | |||
| 6980 | (set-marker e (1- (point))) | 8382 | (set-marker e (1- (point))) |
| 6981 | (cperl-beautify-regexp-piece b e nil deep)))) | 8383 | (cperl-beautify-regexp-piece b e nil deep)))) |
| 6982 | 8384 | ||
| 8385 | (defun cperl-invert-if-unless-modifiers () | ||
| 8386 | "Change `B if A;' into `if (A) {B}' etc if possible. | ||
| 8387 | \(Unfinished.)" | ||
| 8388 | (interactive) ; | ||
| 8389 | (let (A B pre-B post-B pre-if post-if pre-A post-A if-string | ||
| 8390 | (w-rex "\\<\\(if\\|unless\\|while\\|until\\|for\\|foreach\\)\\>")) | ||
| 8391 | (and (= (char-syntax (preceding-char)) ?w) | ||
| 8392 | (forward-sexp -1)) | ||
| 8393 | (setq pre-if (point)) | ||
| 8394 | (cperl-backward-to-start-of-expr) | ||
| 8395 | (setq pre-B (point)) | ||
| 8396 | (forward-sexp 1) ; otherwise forward-to-end-of-expr is NOP | ||
| 8397 | (cperl-forward-to-end-of-expr) | ||
| 8398 | (setq post-A (point)) | ||
| 8399 | (goto-char pre-if) | ||
| 8400 | (or (looking-at w-rex) | ||
| 8401 | ;; Find the position | ||
| 8402 | (progn (goto-char post-A) | ||
| 8403 | (while (and | ||
| 8404 | (not (looking-at w-rex)) | ||
| 8405 | (> (point) pre-B)) | ||
| 8406 | (forward-sexp -1)) | ||
| 8407 | (setq pre-if (point)))) | ||
| 8408 | (or (looking-at w-rex) | ||
| 8409 | (error "Can't find `if', `unless', `while', `until', `for' or `foreach'")) | ||
| 8410 | ;; 1 B 2 ... 3 B-com ... 4 if 5 ... if-com 6 ... 7 A 8 | ||
| 8411 | (setq if-string (buffer-substring (match-beginning 0) (match-end 0))) | ||
| 8412 | ;; First, simple part: find code boundaries | ||
| 8413 | (forward-sexp 1) | ||
| 8414 | (setq post-if (point)) | ||
| 8415 | (forward-sexp -2) | ||
| 8416 | (forward-sexp 1) | ||
| 8417 | (setq post-B (point)) | ||
| 8418 | (cperl-backward-to-start-of-expr) | ||
| 8419 | (setq pre-B (point)) | ||
| 8420 | (setq B (buffer-substring pre-B post-B)) | ||
| 8421 | (goto-char pre-if) | ||
| 8422 | (forward-sexp 2) | ||
| 8423 | (forward-sexp -1) | ||
| 8424 | ;; May be after $, @, $# etc of a variable | ||
| 8425 | (skip-chars-backward "$@%#") | ||
| 8426 | (setq pre-A (point)) | ||
| 8427 | (cperl-forward-to-end-of-expr) | ||
| 8428 | (setq post-A (point)) | ||
| 8429 | (setq A (buffer-substring pre-A post-A)) | ||
| 8430 | ;; Now modify (from end, to not break the stuff) | ||
| 8431 | (skip-chars-forward " \t;") | ||
| 8432 | (delete-region pre-A (point)) ; we move to pre-A | ||
| 8433 | (insert "\n" B ";\n}") | ||
| 8434 | (and (looking-at "[ \t]*#") (cperl-indent-for-comment)) | ||
| 8435 | (delete-region pre-if post-if) | ||
| 8436 | (delete-region pre-B post-B) | ||
| 8437 | (goto-char pre-B) | ||
| 8438 | (insert if-string " (" A ") {") | ||
| 8439 | (setq post-B (point)) | ||
| 8440 | (if (looking-at "[ \t]+$") | ||
| 8441 | (delete-horizontal-space) | ||
| 8442 | (if (looking-at "[ \t]*#") | ||
| 8443 | (cperl-indent-for-comment) | ||
| 8444 | (just-one-space))) | ||
| 8445 | (forward-line 1) | ||
| 8446 | (if (looking-at "[ \t]*$") | ||
| 8447 | (progn ; delete line | ||
| 8448 | (delete-horizontal-space) | ||
| 8449 | (delete-region (point) (1+ (point))))) | ||
| 8450 | (cperl-indent-line) | ||
| 8451 | (goto-char (1- post-B)) | ||
| 8452 | (forward-sexp 1) | ||
| 8453 | (cperl-indent-line) | ||
| 8454 | (goto-char pre-B))) | ||
| 8455 | |||
| 6983 | (defun cperl-invert-if-unless () | 8456 | (defun cperl-invert-if-unless () |
| 6984 | "Change `if (A) {B}' into `B if A;' etc if possible." | 8457 | "Change `if (A) {B}' into `B if A;' etc (or visa versa) if possible. |
| 8458 | If the cursor is not on the leading keyword of the BLOCK flavor of | ||
| 8459 | construct, will assume it is the STATEMENT flavor, so will try to find | ||
| 8460 | the appropriate statement modifier." | ||
| 6985 | (interactive) | 8461 | (interactive) |
| 6986 | (or (looking-at "\\<") | 8462 | (and (= (char-syntax (preceding-char)) ?w) |
| 6987 | (forward-sexp -1)) | 8463 | (forward-sexp -1)) |
| 6988 | (if (looking-at "\\<\\(if\\|unless\\|while\\|until\\|for\\|foreach\\)\\>") | 8464 | (if (looking-at "\\<\\(if\\|unless\\|while\\|until\\|for\\|foreach\\)\\>") |
| 6989 | (let ((pos1 (point)) | 8465 | (let ((pre-if (point)) |
| 6990 | pos2 pos3 pos4 pos5 s1 s2 state p pos45 | 8466 | pre-A post-A pre-B post-B A B state p end-B-code is-block B-comment |
| 6991 | (s0 (buffer-substring (match-beginning 0) (match-end 0)))) | 8467 | (if-string (buffer-substring (match-beginning 0) (match-end 0)))) |
| 6992 | (forward-sexp 2) | 8468 | (forward-sexp 2) |
| 6993 | (setq pos3 (point)) | 8469 | (setq post-A (point)) |
| 6994 | (forward-sexp -1) | 8470 | (forward-sexp -1) |
| 6995 | (setq pos2 (point)) | 8471 | (setq pre-A (point)) |
| 6996 | (if (eq (following-char) ?\( ) | 8472 | (setq is-block (and (eq (following-char) ?\( ) |
| 8473 | (save-excursion | ||
| 8474 | (condition-case nil | ||
| 8475 | (progn | ||
| 8476 | (forward-sexp 2) | ||
| 8477 | (forward-sexp -1) | ||
| 8478 | (eq (following-char) ?\{ )) | ||
| 8479 | (error nil))))) | ||
| 8480 | (if is-block | ||
| 6997 | (progn | 8481 | (progn |
| 6998 | (goto-char pos3) | 8482 | (goto-char post-A) |
| 6999 | (forward-sexp 1) | 8483 | (forward-sexp 1) |
| 7000 | (setq pos5 (point)) | 8484 | (setq post-B (point)) |
| 7001 | (forward-sexp -1) | 8485 | (forward-sexp -1) |
| 7002 | (setq pos4 (point)) | 8486 | (setq pre-B (point)) |
| 7003 | ;; XXXX In fact may be `A if (B); {C}' ... | ||
| 7004 | (if (and (eq (following-char) ?\{ ) | 8487 | (if (and (eq (following-char) ?\{ ) |
| 7005 | (progn | 8488 | (progn |
| 7006 | (cperl-backward-to-noncomment pos3) | 8489 | (cperl-backward-to-noncomment post-A) |
| 7007 | (eq (preceding-char) ?\) ))) | 8490 | (eq (preceding-char) ?\) ))) |
| 7008 | (if (condition-case nil | 8491 | (if (condition-case nil |
| 7009 | (progn | 8492 | (progn |
| 7010 | (goto-char pos5) | 8493 | (goto-char post-B) |
| 7011 | (forward-sexp 1) | 8494 | (forward-sexp 1) |
| 7012 | (forward-sexp -1) | 8495 | (forward-sexp -1) |
| 7013 | (looking-at "\\<els\\(e\\|if\\)\\>")) | 8496 | (looking-at "\\<els\\(e\\|if\\)\\>")) |
| 7014 | (error nil)) | 8497 | (error nil)) |
| 7015 | (error | 8498 | (error |
| 7016 | "`%s' (EXPR) {BLOCK} with `else'/`elsif'" s0) | 8499 | "`%s' (EXPR) {BLOCK} with `else'/`elsif'" if-string) |
| 7017 | (goto-char (1- pos5)) | 8500 | (goto-char (1- post-B)) |
| 7018 | (cperl-backward-to-noncomment pos4) | 8501 | (cperl-backward-to-noncomment pre-B) |
| 7019 | (if (eq (preceding-char) ?\;) | 8502 | (if (eq (preceding-char) ?\;) |
| 7020 | (forward-char -1)) | 8503 | (forward-char -1)) |
| 7021 | (setq pos45 (point)) | 8504 | (setq end-B-code (point)) |
| 7022 | (goto-char pos4) | 8505 | (goto-char pre-B) |
| 7023 | (while (re-search-forward "\\<\\(for\\|foreach\\|if\\|unless\\|while\\|until\\)\\>\\|;" pos45 t) | 8506 | (while (re-search-forward "\\<\\(for\\|foreach\\|if\\|unless\\|while\\|until\\)\\>\\|;" end-B-code t) |
| 7024 | (setq p (match-beginning 0) | 8507 | (setq p (match-beginning 0) |
| 7025 | s1 (buffer-substring p (match-end 0)) | 8508 | A (buffer-substring p (match-end 0)) |
| 7026 | state (parse-partial-sexp pos4 p)) | 8509 | state (parse-partial-sexp pre-B p)) |
| 7027 | (or (nth 3 state) | 8510 | (or (nth 3 state) |
| 7028 | (nth 4 state) | 8511 | (nth 4 state) |
| 7029 | (nth 5 state) | 8512 | (nth 5 state) |
| 7030 | (error "`%s' inside `%s' BLOCK" s1 s0)) | 8513 | (error "`%s' inside `%s' BLOCK" A if-string)) |
| 7031 | (goto-char (match-end 0))) | 8514 | (goto-char (match-end 0))) |
| 7032 | ;; Finally got it | 8515 | ;; Finally got it |
| 7033 | (goto-char (1+ pos4)) | 8516 | (goto-char (1+ pre-B)) |
| 7034 | (skip-chars-forward " \t\n") | 8517 | (skip-chars-forward " \t\n") |
| 7035 | (setq s2 (buffer-substring (point) pos45)) | 8518 | (setq B (buffer-substring (point) end-B-code)) |
| 7036 | (goto-char pos45) | 8519 | (goto-char end-B-code) |
| 7037 | (or (looking-at ";?[ \t\n]*}") | 8520 | (or (looking-at ";?[ \t\n]*}") |
| 7038 | (progn | 8521 | (progn |
| 7039 | (skip-chars-forward "; \t\n") | 8522 | (skip-chars-forward "; \t\n") |
| 7040 | (setq s2 (concat s2 "\n" (buffer-substring (point) (1- pos5)))))) | 8523 | (setq B-comment |
| 7041 | (and (equal s2 "") | 8524 | (buffer-substring (point) (1- post-B))))) |
| 7042 | (setq s2 "1")) | 8525 | (and (equal B "") |
| 7043 | (goto-char (1- pos3)) | 8526 | (setq B "1")) |
| 7044 | (cperl-backward-to-noncomment pos2) | 8527 | (goto-char (1- post-A)) |
| 8528 | (cperl-backward-to-noncomment pre-A) | ||
| 7045 | (or (looking-at "[ \t\n]*)") | 8529 | (or (looking-at "[ \t\n]*)") |
| 7046 | (goto-char (1- pos3))) | 8530 | (goto-char (1- post-A))) |
| 7047 | (setq p (point)) | 8531 | (setq p (point)) |
| 7048 | (goto-char (1+ pos2)) | 8532 | (goto-char (1+ pre-A)) |
| 7049 | (skip-chars-forward " \t\n") | 8533 | (skip-chars-forward " \t\n") |
| 7050 | (setq s1 (buffer-substring (point) p)) | 8534 | (setq A (buffer-substring (point) p)) |
| 7051 | (delete-region pos4 pos5) | 8535 | (delete-region pre-B post-B) |
| 7052 | (delete-region pos2 pos3) | 8536 | (delete-region pre-A post-A) |
| 7053 | (goto-char pos1) | 8537 | (goto-char pre-if) |
| 7054 | (insert s2 " ") | 8538 | (insert B " ") |
| 8539 | (and B-comment (insert B-comment " ")) | ||
| 7055 | (just-one-space) | 8540 | (just-one-space) |
| 7056 | (forward-word 1) | 8541 | (forward-word 1) |
| 7057 | (setq pos1 (point)) | 8542 | (setq pre-A (point)) |
| 7058 | (insert " " s1 ";") | 8543 | (insert " " A ";") |
| 7059 | (delete-horizontal-space) | 8544 | (delete-horizontal-space) |
| 8545 | (setq post-B (point)) | ||
| 8546 | (if (looking-at "#") | ||
| 8547 | (indent-for-comment)) | ||
| 8548 | (goto-char post-B) | ||
| 7060 | (forward-char -1) | 8549 | (forward-char -1) |
| 7061 | (delete-horizontal-space) | 8550 | (delete-horizontal-space) |
| 7062 | (goto-char pos1) | 8551 | (goto-char pre-A) |
| 7063 | (just-one-space) | 8552 | (just-one-space) |
| 7064 | (cperl-indent-line)) | 8553 | (goto-char pre-if) |
| 7065 | (error "`%s' (EXPR) not with an {BLOCK}" s0))) | 8554 | (setq pre-A (set-marker (make-marker) pre-A)) |
| 7066 | (error "`%s' not with an (EXPR)" s0))) | 8555 | (while (<= (point) (marker-position pre-A)) |
| 7067 | (error "Not at `if', `unless', `while', `until', `for' or `foreach'"))) | 8556 | (cperl-indent-line) |
| 8557 | (forward-line 1)) | ||
| 8558 | (goto-char (marker-position pre-A)) | ||
| 8559 | (if B-comment | ||
| 8560 | (progn | ||
| 8561 | (forward-line -1) | ||
| 8562 | (indent-for-comment) | ||
| 8563 | (goto-char (marker-position pre-A))))) | ||
| 8564 | (error "`%s' (EXPR) not with an {BLOCK}" if-string))) | ||
| 8565 | ;; (error "`%s' not with an (EXPR)" if-string) | ||
| 8566 | (forward-sexp -1) | ||
| 8567 | (cperl-invert-if-unless-modifiers))) | ||
| 8568 | ;;(error "Not at `if', `unless', `while', `until', `for' or `foreach'") | ||
| 8569 | (cperl-invert-if-unless-modifiers))) | ||
| 7068 | 8570 | ||
| 7069 | ;;; By Anthony Foiani <afoiani@uswest.com> | 8571 | ;;; By Anthony Foiani <afoiani@uswest.com> |
| 7070 | ;;; Getting help on modules in C-h f ? | 8572 | ;;; Getting help on modules in C-h f ? |
| 7071 | ;;; This is a modified version of `man'. | 8573 | ;;; This is a modified version of `man'. |
| 7072 | ;;; Need to teach it how to lookup functions | 8574 | ;;; Need to teach it how to lookup functions |
| 8575 | ;;;###autoload | ||
| 7073 | (defun cperl-perldoc (word) | 8576 | (defun cperl-perldoc (word) |
| 7074 | "Run `perldoc' on WORD." | 8577 | "Run `perldoc' on WORD." |
| 7075 | (interactive | 8578 | (interactive |
| @@ -7101,6 +8604,7 @@ We suppose that the regexp is scanned already." | |||
| 7101 | (t | 8604 | (t |
| 7102 | (Man-getpage-in-background word))))) | 8605 | (Man-getpage-in-background word))))) |
| 7103 | 8606 | ||
| 8607 | ;;;###autoload | ||
| 7104 | (defun cperl-perldoc-at-point () | 8608 | (defun cperl-perldoc-at-point () |
| 7105 | "Run a `perldoc' on the word around point." | 8609 | "Run a `perldoc' on the word around point." |
| 7106 | (interactive) | 8610 | (interactive) |
| @@ -7145,7 +8649,7 @@ We suppose that the regexp is scanned already." | |||
| 7145 | (defun cperl-pod2man-build-command () | 8649 | (defun cperl-pod2man-build-command () |
| 7146 | "Builds the entire background manpage and cleaning command." | 8650 | "Builds the entire background manpage and cleaning command." |
| 7147 | (let ((command (concat pod2man-program " %s 2>/dev/null")) | 8651 | (let ((command (concat pod2man-program " %s 2>/dev/null")) |
| 7148 | (flist Man-filter-list)) | 8652 | (flist (and (boundp 'Man-filter-list) Man-filter-list))) |
| 7149 | (while (and flist (car flist)) | 8653 | (while (and flist (car flist)) |
| 7150 | (let ((pcom (car (car flist))) | 8654 | (let ((pcom (car (car flist))) |
| 7151 | (pargs (cdr (car flist)))) | 8655 | (pargs (cdr (car flist)))) |
| @@ -7159,6 +8663,205 @@ We suppose that the regexp is scanned already." | |||
| 7159 | (setq flist (cdr flist)))) | 8663 | (setq flist (cdr flist)))) |
| 7160 | command)) | 8664 | command)) |
| 7161 | 8665 | ||
| 8666 | |||
| 8667 | (defun cperl-next-interpolated-REx-1 () | ||
| 8668 | "Move point to next REx which has interpolated parts without //o. | ||
| 8669 | Skips RExes consisting of one interpolated variable. | ||
| 8670 | |||
| 8671 | Note that skipped RExen are not performance hits." | ||
| 8672 | (interactive "") | ||
| 8673 | (cperl-next-interpolated-REx 1)) | ||
| 8674 | |||
| 8675 | (defun cperl-next-interpolated-REx-0 () | ||
| 8676 | "Move point to next REx which has interpolated parts without //o." | ||
| 8677 | (interactive "") | ||
| 8678 | (cperl-next-interpolated-REx 0)) | ||
| 8679 | |||
| 8680 | (defun cperl-next-interpolated-REx (&optional skip beg limit) | ||
| 8681 | "Move point to next REx which has interpolated parts. | ||
| 8682 | SKIP is a list of possible types to skip, BEG and LIMIT are the starting | ||
| 8683 | point and the limit of search (default to point and end of buffer). | ||
| 8684 | |||
| 8685 | SKIP may be a number, then it behaves as list of numbers up to SKIP; this | ||
| 8686 | semantic may be used as a numeric argument. | ||
| 8687 | |||
| 8688 | Types are 0 for / $rex /o (interpolated once), 1 for /$rex/ (if $rex is | ||
| 8689 | a result of qr//, this is not a performance hit), t for the rest." | ||
| 8690 | (interactive "P") | ||
| 8691 | (if (numberp skip) (setq skip (list 0 skip))) | ||
| 8692 | (or beg (setq beg (point))) | ||
| 8693 | (or limit (setq limit (point-max))) ; needed for n-s-p-c | ||
| 8694 | (let (pp) | ||
| 8695 | (and (eq (get-text-property beg 'syntax-type) 'string) | ||
| 8696 | (setq beg (next-single-property-change beg 'syntax-type nil limit))) | ||
| 8697 | (cperl-map-pods-heres | ||
| 8698 | (function (lambda (s e p) | ||
| 8699 | (if (memq (get-text-property s 'REx-interpolated) skip) | ||
| 8700 | t | ||
| 8701 | (setq pp s) | ||
| 8702 | nil))) ; nil stops | ||
| 8703 | 'REx-interpolated beg limit) | ||
| 8704 | (if pp (goto-char pp) | ||
| 8705 | (message "No more interpolated REx")))) | ||
| 8706 | |||
| 8707 | ;;; Initial version contributed by Trey Belew | ||
| 8708 | (defun cperl-here-doc-spell (&optional beg end) | ||
| 8709 | "Spell-check HERE-documents in the Perl buffer. | ||
| 8710 | If a region is highlighted, restricts to the region." | ||
| 8711 | (interactive "") | ||
| 8712 | (cperl-pod-spell t beg end)) | ||
| 8713 | |||
| 8714 | (defun cperl-pod-spell (&optional do-heres beg end) | ||
| 8715 | "Spell-check POD documentation. | ||
| 8716 | If invoked with prefix argument, will do HERE-DOCs instead. | ||
| 8717 | If a region is highlighted, restricts to the region." | ||
| 8718 | (interactive "P") | ||
| 8719 | (save-excursion | ||
| 8720 | (let (beg end) | ||
| 8721 | (if (cperl-mark-active) | ||
| 8722 | (setq beg (min (mark) (point)) | ||
| 8723 | end (max (mark) (point))) | ||
| 8724 | (setq beg (point-min) | ||
| 8725 | end (point-max))) | ||
| 8726 | (cperl-map-pods-heres (function | ||
| 8727 | (lambda (s e p) | ||
| 8728 | (if do-heres | ||
| 8729 | (setq e (save-excursion | ||
| 8730 | (goto-char e) | ||
| 8731 | (forward-line -1) | ||
| 8732 | (point)))) | ||
| 8733 | (ispell-region s e) | ||
| 8734 | t)) | ||
| 8735 | (if do-heres 'here-doc-group 'in-pod) | ||
| 8736 | beg end)))) | ||
| 8737 | |||
| 8738 | (defun cperl-map-pods-heres (func &optional prop s end) | ||
| 8739 | "Executes a function over regions of pods or here-documents. | ||
| 8740 | PROP is the text-property to search for; default to `in-pod'. Stop when | ||
| 8741 | function returns nil." | ||
| 8742 | (let (pos posend has-prop (cont t)) | ||
| 8743 | (or prop (setq prop 'in-pod)) | ||
| 8744 | (or s (setq s (point-min))) | ||
| 8745 | (or end (setq end (point-max))) | ||
| 8746 | (cperl-update-syntaxification end end) | ||
| 8747 | (save-excursion | ||
| 8748 | (goto-char (setq pos s)) | ||
| 8749 | (while (and cont (< pos end)) | ||
| 8750 | (setq has-prop (get-text-property pos prop)) | ||
| 8751 | (setq posend (next-single-property-change pos prop nil end)) | ||
| 8752 | (and has-prop | ||
| 8753 | (setq cont (funcall func pos posend prop))) | ||
| 8754 | (setq pos posend))))) | ||
| 8755 | |||
| 8756 | ;;; Based on code by Masatake YAMATO: | ||
| 8757 | (defun cperl-get-here-doc-region (&optional pos pod) | ||
| 8758 | "Return HERE document region around the point. | ||
| 8759 | Return nil if the point is not in a HERE document region. If POD is non-nil, | ||
| 8760 | will return a POD section if point is in a POD section." | ||
| 8761 | (or pos (setq pos (point))) | ||
| 8762 | (cperl-update-syntaxification pos pos) | ||
| 8763 | (if (or (eq 'here-doc (get-text-property pos 'syntax-type)) | ||
| 8764 | (and pod | ||
| 8765 | (eq 'pod (get-text-property pos 'syntax-type)))) | ||
| 8766 | (let ((b (cperl-beginning-of-property pos 'syntax-type)) | ||
| 8767 | (e (next-single-property-change pos 'syntax-type))) | ||
| 8768 | (cons b (or e (point-max)))))) | ||
| 8769 | |||
| 8770 | (defun cperl-narrow-to-here-doc (&optional pos) | ||
| 8771 | "Narrows editing region to the HERE-DOC at POS. | ||
| 8772 | POS defaults to the point." | ||
| 8773 | (interactive "d") | ||
| 8774 | (or pos (setq pos (point))) | ||
| 8775 | (let ((p (cperl-get-here-doc-region pos))) | ||
| 8776 | (or p (error "Not inside a HERE document")) | ||
| 8777 | (narrow-to-region (car p) (cdr p)) | ||
| 8778 | (message | ||
| 8779 | "When you are finished with narrow editing, type C-x n w"))) | ||
| 8780 | |||
| 8781 | (defun cperl-select-this-pod-or-here-doc (&optional pos) | ||
| 8782 | "Select the HERE-DOC (or POD section) at POS. | ||
| 8783 | POS defaults to the point." | ||
| 8784 | (interactive "d") | ||
| 8785 | (let ((p (cperl-get-here-doc-region pos t))) | ||
| 8786 | (if p | ||
| 8787 | (progn | ||
| 8788 | (goto-char (car p)) | ||
| 8789 | (push-mark (cdr p) nil t)) ; Message, activate in transient-mode | ||
| 8790 | (message "I do not think POS is in POD or a HERE-doc...")))) | ||
| 8791 | |||
| 8792 | (defun cperl-facemenu-add-face-function (face end) | ||
| 8793 | "A callback to process user-initiated font-change requests. | ||
| 8794 | Translates `bold', `italic', and `bold-italic' requests to insertion of | ||
| 8795 | corresponding POD directives, and `underline' to C<> POD directive. | ||
| 8796 | |||
| 8797 | Such requests are usually bound to M-o LETTER." | ||
| 8798 | (or (get-text-property (point) 'in-pod) | ||
| 8799 | (error "Faces can only be set within POD")) | ||
| 8800 | (setq facemenu-end-add-face (if (eq face 'bold-italic) ">>" ">")) | ||
| 8801 | (cdr (or (assq face '((bold . "B<") | ||
| 8802 | (italic . "I<") | ||
| 8803 | (bold-italic . "B<I<") | ||
| 8804 | (underline . "C<"))) | ||
| 8805 | (error "Face %s not configured for cperl-mode" | ||
| 8806 | face)))) | ||
| 8807 | |||
| 8808 | (defun cperl-time-fontification (&optional l step lim) | ||
| 8809 | "Times how long it takes to do incremental fontification in a region. | ||
| 8810 | L is the line to start at, STEP is the number of lines to skip when | ||
| 8811 | doing next incremental fontification, LIM is the maximal number of | ||
| 8812 | incremental fontification to perform. Messages are accumulated in | ||
| 8813 | *Messages* buffer. | ||
| 8814 | |||
| 8815 | May be used for pinpointing which construct slows down buffer fontification: | ||
| 8816 | start with default arguments, then refine the slowdown regions." | ||
| 8817 | (interactive "nLine to start at: \nnStep to do incremental fontification: ") | ||
| 8818 | (or l (setq l 1)) | ||
| 8819 | (or step (setq step 500)) | ||
| 8820 | (or lim (setq lim 40)) | ||
| 8821 | (let* ((timems (function (lambda () | ||
| 8822 | (let ((tt (current-time))) | ||
| 8823 | (+ (* 1000 (nth 1 tt)) (/ (nth 2 tt) 1000)))))) | ||
| 8824 | (tt (funcall timems)) (c 0) delta tot) | ||
| 8825 | (goto-line l) | ||
| 8826 | (cperl-mode) | ||
| 8827 | (setq tot (- (- tt (setq tt (funcall timems))))) | ||
| 8828 | (message "cperl-mode at %s: %s" l tot) | ||
| 8829 | (while (and (< c lim) (not (eobp))) | ||
| 8830 | (forward-line step) | ||
| 8831 | (setq l (+ l step)) | ||
| 8832 | (setq c (1+ c)) | ||
| 8833 | (cperl-update-syntaxification (point) (point)) | ||
| 8834 | (setq delta (- (- tt (setq tt (funcall timems)))) tot (+ tot delta)) | ||
| 8835 | (message "to %s:%6s,%7s" l delta tot)) | ||
| 8836 | tot)) | ||
| 8837 | |||
| 8838 | (defun cperl-emulate-lazy-lock (&optional window-size) | ||
| 8839 | "Emulate `lazy-lock' without `condition-case', so `debug-on-error' works. | ||
| 8840 | Start fontifying the buffer from the start (or end) using the given | ||
| 8841 | WINDOW-SIZE (units is lines). Negative WINDOW-SIZE starts at end, and | ||
| 8842 | goes backwards; default is -50. This function is not CPerl-specific; it | ||
| 8843 | may be used to debug problems with delayed incremental fontification." | ||
| 8844 | (interactive | ||
| 8845 | "nSize of window for incremental fontification, negative goes backwards: ") | ||
| 8846 | (or window-size (setq window-size -50)) | ||
| 8847 | (let ((pos (if (> window-size 0) | ||
| 8848 | (point-min) | ||
| 8849 | (point-max))) | ||
| 8850 | p) | ||
| 8851 | (goto-char pos) | ||
| 8852 | (normal-mode) | ||
| 8853 | ;; Why needed??? With older font-locks??? | ||
| 8854 | (set (make-local-variable 'font-lock-cache-position) (make-marker)) | ||
| 8855 | (while (if (> window-size 0) | ||
| 8856 | (< pos (point-max)) | ||
| 8857 | (> pos (point-min))) | ||
| 8858 | (setq p (progn | ||
| 8859 | (forward-line window-size) | ||
| 8860 | (point))) | ||
| 8861 | (font-lock-fontify-region (min p pos) (max p pos)) | ||
| 8862 | (setq pos p)))) | ||
| 8863 | |||
| 8864 | |||
| 7162 | (defun cperl-lazy-install ()) ; Avoid a warning | 8865 | (defun cperl-lazy-install ()) ; Avoid a warning |
| 7163 | (defun cperl-lazy-unstall ()) ; Avoid a warning | 8866 | (defun cperl-lazy-unstall ()) ; Avoid a warning |
| 7164 | 8867 | ||
| @@ -7174,7 +8877,7 @@ We suppose that the regexp is scanned already." | |||
| 7174 | "Switches on Auto-Help on Perl constructs (put in the message area). | 8877 | "Switches on Auto-Help on Perl constructs (put in the message area). |
| 7175 | Delay of auto-help controlled by `cperl-lazy-help-time'." | 8878 | Delay of auto-help controlled by `cperl-lazy-help-time'." |
| 7176 | (interactive) | 8879 | (interactive) |
| 7177 | (make-variable-buffer-local 'cperl-help-shown) | 8880 | (make-local-variable 'cperl-help-shown) |
| 7178 | (if (and (cperl-val 'cperl-lazy-help-time) | 8881 | (if (and (cperl-val 'cperl-lazy-help-time) |
| 7179 | (not cperl-lazy-installed)) | 8882 | (not cperl-lazy-installed)) |
| 7180 | (progn | 8883 | (progn |
| @@ -7207,48 +8910,109 @@ Delay of auto-help controlled by `cperl-lazy-help-time'." | |||
| 7207 | ;;; Plug for wrong font-lock: | 8910 | ;;; Plug for wrong font-lock: |
| 7208 | 8911 | ||
| 7209 | (defun cperl-font-lock-unfontify-region-function (beg end) | 8912 | (defun cperl-font-lock-unfontify-region-function (beg end) |
| 7210 | ;; Simplified now that font-lock-unfontify-region uses save-buffer-state. | 8913 | (let* ((modified (buffer-modified-p)) (buffer-undo-list t) |
| 7211 | (let (before-change-functions after-change-functions) | 8914 | (inhibit-read-only t) (inhibit-point-motion-hooks t) |
| 7212 | (remove-text-properties beg end '(face nil)))) | 8915 | before-change-functions after-change-functions |
| 8916 | deactivate-mark buffer-file-name buffer-file-truename) | ||
| 8917 | (remove-text-properties beg end '(face nil)) | ||
| 8918 | (if (and (not modified) (buffer-modified-p)) | ||
| 8919 | (set-buffer-modified-p nil)))) | ||
| 8920 | |||
| 8921 | (defun cperl-font-lock-fontify-region-function (beg end loudly) | ||
| 8922 | "Extends the region to safe positions, then calls the default function. | ||
| 8923 | Newer `font-lock's can do it themselves. | ||
| 8924 | We unwind only as far as needed for fontification. Syntaxification may | ||
| 8925 | do extra unwind via `cperl-unwind-to-safe'." | ||
| 8926 | (save-excursion | ||
| 8927 | (goto-char beg) | ||
| 8928 | (while (and beg | ||
| 8929 | (progn | ||
| 8930 | (beginning-of-line) | ||
| 8931 | (eq (get-text-property (setq beg (point)) 'syntax-type) | ||
| 8932 | 'multiline))) | ||
| 8933 | (if (setq beg (cperl-beginning-of-property beg 'syntax-type)) | ||
| 8934 | (goto-char beg))) | ||
| 8935 | (setq beg (point)) | ||
| 8936 | (goto-char end) | ||
| 8937 | (while (and end | ||
| 8938 | (progn | ||
| 8939 | (or (bolp) (condition-case nil | ||
| 8940 | (forward-line 1) | ||
| 8941 | (error nil))) | ||
| 8942 | (eq (get-text-property (setq end (point)) 'syntax-type) | ||
| 8943 | 'multiline))) | ||
| 8944 | (setq end (next-single-property-change end 'syntax-type nil (point-max))) | ||
| 8945 | (goto-char end)) | ||
| 8946 | (setq end (point))) | ||
| 8947 | (font-lock-default-fontify-region beg end loudly)) | ||
| 7213 | 8948 | ||
| 7214 | (defvar cperl-d-l nil) | 8949 | (defvar cperl-d-l nil) |
| 7215 | (defun cperl-fontify-syntaxically (end) | 8950 | (defun cperl-fontify-syntaxically (end) |
| 7216 | ;; Some vars for debugging only | 8951 | ;; Some vars for debugging only |
| 7217 | ;; (message "Syntaxifying...") | 8952 | ;; (message "Syntaxifying...") |
| 7218 | (let ((dbg (point)) (iend end) | 8953 | (let ((dbg (point)) (iend end) (idone cperl-syntax-done-to) |
| 7219 | (istate (car cperl-syntax-state)) | 8954 | (istate (car cperl-syntax-state)) |
| 7220 | start) | 8955 | start from-start edebug-backtrace-buffer) |
| 7221 | (and cperl-syntaxify-unwind | 8956 | (if (eq cperl-syntaxify-by-font-lock 'backtrace) |
| 7222 | (setq end (cperl-unwind-to-safe t end))) | 8957 | (progn |
| 7223 | (setq start (point)) | 8958 | (require 'edebug) |
| 8959 | (let ((f 'edebug-backtrace)) | ||
| 8960 | (funcall f)))) ; Avoid compile-time warning | ||
| 7224 | (or cperl-syntax-done-to | 8961 | (or cperl-syntax-done-to |
| 7225 | (setq cperl-syntax-done-to (point-min))) | 8962 | (setq cperl-syntax-done-to (point-min) |
| 7226 | (if (or (not (boundp 'font-lock-hot-pass)) | 8963 | from-start t)) |
| 7227 | (eval 'font-lock-hot-pass) | 8964 | (setq start (if (and cperl-hook-after-change |
| 7228 | t) ; Not debugged otherwise | 8965 | (not from-start)) |
| 7229 | ;; Need to forget what is after `start' | 8966 | cperl-syntax-done-to ; Fontify without change; ignore start |
| 7230 | (setq start (min cperl-syntax-done-to start)) | 8967 | ;; Need to forget what is after `start' |
| 7231 | ;; Fontification without a change | 8968 | (min cperl-syntax-done-to (point)))) |
| 7232 | (setq start (max cperl-syntax-done-to start))) | 8969 | (goto-char start) |
| 8970 | (beginning-of-line) | ||
| 8971 | (setq start (point)) | ||
| 8972 | (and cperl-syntaxify-unwind | ||
| 8973 | (setq end (cperl-unwind-to-safe t end) | ||
| 8974 | start (point))) | ||
| 7233 | (and (> end start) | 8975 | (and (> end start) |
| 7234 | (setq cperl-syntax-done-to start) ; In case what follows fails | 8976 | (setq cperl-syntax-done-to start) ; In case what follows fails |
| 7235 | (cperl-find-pods-heres start end t nil t)) | 8977 | (cperl-find-pods-heres start end t nil t)) |
| 7236 | (if (eq cperl-syntaxify-by-font-lock 'message) | 8978 | (if (memq cperl-syntaxify-by-font-lock '(backtrace message)) |
| 7237 | (message "Syntaxified %s..%s from %s to %s(%s), state %s-->%s" | 8979 | (message "Syxify req=%s..%s actual=%s..%s done-to: %s=>%s statepos: %s=>%s" |
| 7238 | dbg iend | 8980 | dbg iend start end idone cperl-syntax-done-to |
| 7239 | start end cperl-syntax-done-to | ||
| 7240 | istate (car cperl-syntax-state))) ; For debugging | 8981 | istate (car cperl-syntax-state))) ; For debugging |
| 7241 | nil)) ; Do not iterate | 8982 | nil)) ; Do not iterate |
| 7242 | 8983 | ||
| 7243 | (defun cperl-fontify-update (end) | 8984 | (defun cperl-fontify-update (end) |
| 7244 | (let ((pos (point)) prop posend) | 8985 | (let ((pos (point-min)) prop posend) |
| 8986 | (setq end (point-max)) | ||
| 7245 | (while (< pos end) | 8987 | (while (< pos end) |
| 7246 | (setq prop (get-text-property pos 'cperl-postpone)) | 8988 | (setq prop (get-text-property pos 'cperl-postpone) |
| 7247 | (setq posend (next-single-property-change pos 'cperl-postpone nil end)) | 8989 | posend (next-single-property-change pos 'cperl-postpone nil end)) |
| 7248 | (and prop (put-text-property pos posend (car prop) (cdr prop))) | 8990 | (and prop (put-text-property pos posend (car prop) (cdr prop))) |
| 7249 | (setq pos posend))) | 8991 | (setq pos posend))) |
| 7250 | nil) ; Do not iterate | 8992 | nil) ; Do not iterate |
| 7251 | 8993 | ||
| 8994 | (defun cperl-fontify-update-bad (end) | ||
| 8995 | ;; Since fontification happens with different region than syntaxification, | ||
| 8996 | ;; do to the end of buffer, not to END;;; likewise, start earlier if needed | ||
| 8997 | (let* ((pos (point)) (prop (get-text-property pos 'cperl-postpone)) posend) | ||
| 8998 | (if prop | ||
| 8999 | (setq pos (or (cperl-beginning-of-property | ||
| 9000 | (cperl-1+ pos) 'cperl-postpone) | ||
| 9001 | (point-min)))) | ||
| 9002 | (while (< pos end) | ||
| 9003 | (setq posend (next-single-property-change pos 'cperl-postpone)) | ||
| 9004 | (and prop (put-text-property pos posend (car prop) (cdr prop))) | ||
| 9005 | (setq pos posend) | ||
| 9006 | (setq prop (get-text-property pos 'cperl-postpone)))) | ||
| 9007 | nil) ; Do not iterate | ||
| 9008 | |||
| 9009 | ;; Called when any modification is made to buffer text. | ||
| 9010 | (defun cperl-after-change-function (beg end old-len) | ||
| 9011 | ;; We should have been informed about changes by `font-lock'. Since it | ||
| 9012 | ;; does not inform as which calls are defered, do it ourselves | ||
| 9013 | (if cperl-syntax-done-to | ||
| 9014 | (setq cperl-syntax-done-to (min cperl-syntax-done-to beg)))) | ||
| 9015 | |||
| 7252 | (defun cperl-update-syntaxification (from to) | 9016 | (defun cperl-update-syntaxification (from to) |
| 7253 | (if (and cperl-use-syntax-table-text-property | 9017 | (if (and cperl-use-syntax-table-text-property |
| 7254 | cperl-syntaxify-by-font-lock | 9018 | cperl-syntaxify-by-font-lock |
| @@ -7260,7 +9024,7 @@ Delay of auto-help controlled by `cperl-lazy-help-time'." | |||
| 7260 | (cperl-fontify-syntaxically to))))) | 9024 | (cperl-fontify-syntaxically to))))) |
| 7261 | 9025 | ||
| 7262 | (defvar cperl-version | 9026 | (defvar cperl-version |
| 7263 | (let ((v "Revision: 5.0")) | 9027 | (let ((v "Revision: 5.22")) |
| 7264 | (string-match ":\\s *\\([0-9.]+\\)" v) | 9028 | (string-match ":\\s *\\([0-9.]+\\)" v) |
| 7265 | (substring v (match-beginning 1) (match-end 1))) | 9029 | (substring v (match-beginning 1) (match-end 1))) |
| 7266 | "Version of IZ-supported CPerl package this file is based on.") | 9030 | "Version of IZ-supported CPerl package this file is based on.") |
diff --git a/lisp/progmodes/ebnf2ps.el b/lisp/progmodes/ebnf2ps.el index bce4381c614..9f27c8a60f1 100644 --- a/lisp/progmodes/ebnf2ps.el +++ b/lisp/progmodes/ebnf2ps.el | |||
| @@ -5,10 +5,10 @@ | |||
| 5 | 5 | ||
| 6 | ;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br> | 6 | ;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br> |
| 7 | ;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> | 7 | ;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> |
| 8 | ;; Time-stamp: <2005-09-18 07:27:20 deego> | 8 | ;; Time-stamp: <2006/09/26 21:49:46 vinicius> |
| 9 | ;; Keywords: wp, ebnf, PostScript | 9 | ;; Keywords: wp, ebnf, PostScript |
| 10 | ;; Version: 4.2 | 10 | ;; Version: 4.3 |
| 11 | ;; X-URL: http://www.cpqd.com.br/~vinicius/emacs/ | 11 | ;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre |
| 12 | 12 | ||
| 13 | ;; This file is part of GNU Emacs. | 13 | ;; This file is part of GNU Emacs. |
| 14 | 14 | ||
| @@ -27,8 +27,8 @@ | |||
| 27 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, | 27 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
| 28 | ;; Boston, MA 02110-1301, USA. | 28 | ;; Boston, MA 02110-1301, USA. |
| 29 | 29 | ||
| 30 | (defconst ebnf-version "4.2" | 30 | (defconst ebnf-version "4.3" |
| 31 | "ebnf2ps.el, v 4.2 <2004/04/04 vinicius> | 31 | "ebnf2ps.el, v 4.3 <2006/09/26 vinicius> |
| 32 | 32 | ||
| 33 | Vinicius's last change version. When reporting bugs, please also | 33 | Vinicius's last change version. When reporting bugs, please also |
| 34 | report the version of Emacs, if any, that ebnf2ps was running with. | 34 | report the version of Emacs, if any, that ebnf2ps was running with. |
| @@ -73,18 +73,18 @@ Please send all bug fixes and enhancements to | |||
| 73 | ;; ebnf2ps provides the following commands for generating PostScript syntactic | 73 | ;; ebnf2ps provides the following commands for generating PostScript syntactic |
| 74 | ;; chart images of Emacs buffers: | 74 | ;; chart images of Emacs buffers: |
| 75 | ;; | 75 | ;; |
| 76 | ;; ebnf-print-directory | 76 | ;; ebnf-print-directory |
| 77 | ;; ebnf-print-file | 77 | ;; ebnf-print-file |
| 78 | ;; ebnf-print-buffer | 78 | ;; ebnf-print-buffer |
| 79 | ;; ebnf-print-region | 79 | ;; ebnf-print-region |
| 80 | ;; ebnf-spool-directory | 80 | ;; ebnf-spool-directory |
| 81 | ;; ebnf-spool-file | 81 | ;; ebnf-spool-file |
| 82 | ;; ebnf-spool-buffer | 82 | ;; ebnf-spool-buffer |
| 83 | ;; ebnf-spool-region | 83 | ;; ebnf-spool-region |
| 84 | ;; ebnf-eps-directory | 84 | ;; ebnf-eps-directory |
| 85 | ;; ebnf-eps-file | 85 | ;; ebnf-eps-file |
| 86 | ;; ebnf-eps-buffer | 86 | ;; ebnf-eps-buffer |
| 87 | ;; ebnf-eps-region | 87 | ;; ebnf-eps-region |
| 88 | ;; | 88 | ;; |
| 89 | ;; These commands all perform essentially the same function: they generate | 89 | ;; These commands all perform essentially the same function: they generate |
| 90 | ;; PostScript syntactic chart images suitable for printing on a PostScript | 90 | ;; PostScript syntactic chart images suitable for printing on a PostScript |
| @@ -94,14 +94,14 @@ Please send all bug fixes and enhancements to | |||
| 94 | ;; The word "print", "spool" and "eps" in the command name determines when the | 94 | ;; The word "print", "spool" and "eps" in the command name determines when the |
| 95 | ;; PostScript image is sent to the printer (or file): | 95 | ;; PostScript image is sent to the printer (or file): |
| 96 | ;; | 96 | ;; |
| 97 | ;; print - The PostScript image is immediately sent to the printer; | 97 | ;; print - The PostScript image is immediately sent to the printer; |
| 98 | ;; | 98 | ;; |
| 99 | ;; spool - The PostScript image is saved temporarily in an Emacs buffer. | 99 | ;; spool - The PostScript image is saved temporarily in an Emacs buffer. |
| 100 | ;; Many images may be spooled locally before printing them. To | 100 | ;; Many images may be spooled locally before printing them. To |
| 101 | ;; send the spooled images to the printer, use the command | 101 | ;; send the spooled images to the printer, use the command |
| 102 | ;; `ebnf-despool'. | 102 | ;; `ebnf-despool'. |
| 103 | ;; | 103 | ;; |
| 104 | ;; eps - The PostScript image is immediately sent to a EPS file. | 104 | ;; eps - The PostScript image is immediately sent to a EPS file. |
| 105 | ;; | 105 | ;; |
| 106 | ;; The spooling mechanism is the same as used by ps-print and was designed for | 106 | ;; The spooling mechanism is the same as used by ps-print and was designed for |
| 107 | ;; printing lots of small files to save paper that would otherwise be wasted on | 107 | ;; printing lots of small files to save paper that would otherwise be wasted on |
| @@ -120,22 +120,22 @@ Please send all bug fixes and enhancements to | |||
| 120 | ;; The word "directory", "file", "buffer" or "region" in the command name | 120 | ;; The word "directory", "file", "buffer" or "region" in the command name |
| 121 | ;; determines how much of the buffer is printed: | 121 | ;; determines how much of the buffer is printed: |
| 122 | ;; | 122 | ;; |
| 123 | ;; directory - Read files in the directory and print them. | 123 | ;; directory - Read files in the directory and print them. |
| 124 | ;; | 124 | ;; |
| 125 | ;; file - Read file and print it. | 125 | ;; file - Read file and print it. |
| 126 | ;; | 126 | ;; |
| 127 | ;; buffer - Print the entire buffer. | 127 | ;; buffer - Print the entire buffer. |
| 128 | ;; | 128 | ;; |
| 129 | ;; region - Print just the current region. | 129 | ;; region - Print just the current region. |
| 130 | ;; | 130 | ;; |
| 131 | ;; Two ebnf- command examples: | 131 | ;; Two ebnf- command examples: |
| 132 | ;; | 132 | ;; |
| 133 | ;; ebnf-print-buffer - translate and print the entire buffer, and send it | 133 | ;; ebnf-print-buffer - translate and print the entire buffer, and send it |
| 134 | ;; immediately to the printer. | 134 | ;; immediately to the printer. |
| 135 | ;; | 135 | ;; |
| 136 | ;; ebnf-spool-region - translate and print just the current region, and | 136 | ;; ebnf-spool-region - translate and print just the current region, and |
| 137 | ;; spool the image in Emacs to send to the printer | 137 | ;; spool the image in Emacs to send to the printer |
| 138 | ;; later. | 138 | ;; later. |
| 139 | ;; | 139 | ;; |
| 140 | ;; Note that `ebnf-eps-directory', `ebnf-eps-file', `ebnf-eps-buffer' and | 140 | ;; Note that `ebnf-eps-directory', `ebnf-eps-file', `ebnf-eps-buffer' and |
| 141 | ;; `ebnf-eps-region' never spool the EPS image, so they don't use the ps-print | 141 | ;; `ebnf-eps-region' never spool the EPS image, so they don't use the ps-print |
| @@ -148,13 +148,13 @@ Please send all bug fixes and enhancements to | |||
| 148 | ;; | 148 | ;; |
| 149 | ;; To translate and print your buffer, type | 149 | ;; To translate and print your buffer, type |
| 150 | ;; | 150 | ;; |
| 151 | ;; M-x ebnf-print-buffer | 151 | ;; M-x ebnf-print-buffer |
| 152 | ;; | 152 | ;; |
| 153 | ;; or substitute one of the other four ebnf- commands. The command will | 153 | ;; or substitute one of the other four ebnf- commands. The command will |
| 154 | ;; generate the PostScript image and print or spool it as specified. By giving | 154 | ;; generate the PostScript image and print or spool it as specified. By giving |
| 155 | ;; the command a prefix argument | 155 | ;; the command a prefix argument |
| 156 | ;; | 156 | ;; |
| 157 | ;; C-u M-x ebnf-print-buffer | 157 | ;; C-u M-x ebnf-print-buffer |
| 158 | ;; | 158 | ;; |
| 159 | ;; it will save the PostScript image to a file instead of sending it to the | 159 | ;; it will save the PostScript image to a file instead of sending it to the |
| 160 | ;; printer; you will be prompted for the name of the file to save the image to. | 160 | ;; printer; you will be prompted for the name of the file to save the image to. |
| @@ -162,7 +162,7 @@ Please send all bug fixes and enhancements to | |||
| 162 | ;; you may save the spooled images to a file by giving a prefix argument to | 162 | ;; you may save the spooled images to a file by giving a prefix argument to |
| 163 | ;; `ebnf-despool': | 163 | ;; `ebnf-despool': |
| 164 | ;; | 164 | ;; |
| 165 | ;; C-u M-x ebnf-despool | 165 | ;; C-u M-x ebnf-despool |
| 166 | ;; | 166 | ;; |
| 167 | ;; When invoked this way, `ebnf-despool' will prompt you for the name of the | 167 | ;; When invoked this way, `ebnf-despool' will prompt you for the name of the |
| 168 | ;; file to save to. | 168 | ;; file to save to. |
| @@ -172,9 +172,9 @@ Please send all bug fixes and enhancements to | |||
| 172 | ;; | 172 | ;; |
| 173 | ;; Any of the `ebnf-' commands can be bound to keys. Here are some examples: | 173 | ;; Any of the `ebnf-' commands can be bound to keys. Here are some examples: |
| 174 | ;; | 174 | ;; |
| 175 | ;; (global-set-key 'f22 'ebnf-print-buffer) ;f22 is prsc | 175 | ;; (global-set-key 'f22 'ebnf-print-buffer) ;f22 is prsc |
| 176 | ;; (global-set-key '(shift f22) 'ebnf-print-region) | 176 | ;; (global-set-key '(shift f22) 'ebnf-print-region) |
| 177 | ;; (global-set-key '(control f22) 'ebnf-despool) | 177 | ;; (global-set-key '(control f22) 'ebnf-despool) |
| 178 | ;; | 178 | ;; |
| 179 | ;; | 179 | ;; |
| 180 | ;; Invoking Ebnf2ps in Batch | 180 | ;; Invoking Ebnf2ps in Batch |
| @@ -523,14 +523,14 @@ Please send all bug fixes and enhancements to | |||
| 523 | ;; | 523 | ;; |
| 524 | ;; The following table summarizes the results: | 524 | ;; The following table summarizes the results: |
| 525 | ;; | 525 | ;; |
| 526 | ;; EPS FILE NAME NO SORT ASCENDING SORT DESCENDING SORT | 526 | ;; EPS FILE NAME NO SORT ASCENDING SORT DESCENDING SORT |
| 527 | ;; ebnf--AA.eps A C A C C A | 527 | ;; ebnf--AA.eps A C A C C A |
| 528 | ;; ebnf--BB.eps C B B C C B | 528 | ;; ebnf--BB.eps C B B C C B |
| 529 | ;; ebnf--CC.eps A C B F A B C F F C B A | 529 | ;; ebnf--CC.eps A C B F A B C F F C B A |
| 530 | ;; ebnf--D.eps D D D | 530 | ;; ebnf--D.eps D D D |
| 531 | ;; ebnf--E.eps E E E | 531 | ;; ebnf--E.eps E E E |
| 532 | ;; ebnf--G.eps G G G | 532 | ;; ebnf--G.eps G G G |
| 533 | ;; ebnf--Z.eps Z Z Z | 533 | ;; ebnf--Z.eps Z Z Z |
| 534 | ;; | 534 | ;; |
| 535 | ;; As you can see if EPS actions is not used, each single production is | 535 | ;; As you can see if EPS actions is not used, each single production is |
| 536 | ;; generated per EPS file. To avoid overriding EPS files, use names in ;[ that | 536 | ;; generated per EPS file. To avoid overriding EPS files, use names in ;[ that |
| @@ -692,6 +692,11 @@ Please send all bug fixes and enhancements to | |||
| 692 | ;; | 692 | ;; |
| 693 | ;; `ebnf-line-color' Specify flow line color. | 693 | ;; `ebnf-line-color' Specify flow line color. |
| 694 | ;; | 694 | ;; |
| 695 | ;; `ebnf-arrow-extra-width' Specify extra width for arrow shape | ||
| 696 | ;; drawing. | ||
| 697 | ;; | ||
| 698 | ;; `ebnf-arrow-scale' Specify the arrow scale. | ||
| 699 | ;; | ||
| 695 | ;; `ebnf-user-arrow' Specify a sexp for user arrow shape (a | 700 | ;; `ebnf-user-arrow' Specify a sexp for user arrow shape (a |
| 696 | ;; PostScript code). | 701 | ;; PostScript code). |
| 697 | ;; | 702 | ;; |
| @@ -824,6 +829,8 @@ Please send all bug fixes and enhancements to | |||
| 824 | ;; entry is the vertical position used to know where it should | 829 | ;; entry is the vertical position used to know where it should |
| 825 | ;; be drawn the flow line in the current element. | 830 | ;; be drawn the flow line in the current element. |
| 826 | ;; | 831 | ;; |
| 832 | ;; extra is given by `ebnf-arrow-extra-width'. | ||
| 833 | ;; | ||
| 827 | ;; | 834 | ;; |
| 828 | ;; * SPECIAL, TERMINAL and NON-TERMINAL | 835 | ;; * SPECIAL, TERMINAL and NON-TERMINAL |
| 829 | ;; | 836 | ;; |
| @@ -835,17 +842,17 @@ Please send all bug fixes and enhancements to | |||
| 835 | ;; : | : : | : } font height / 2 } | 842 | ;; : | : : | : } font height / 2 } |
| 836 | ;; : +==============+...:............................... | 843 | ;; : +==============+...:............................... |
| 837 | ;; : : : : : : | 844 | ;; : : : : : : |
| 838 | ;; : : : : : :...................... | 845 | ;; : : : : : :......................... |
| 839 | ;; : : : : : } font height } | 846 | ;; : : : : : } font height } |
| 840 | ;; : : : : :....... } | 847 | ;; : : : : :....... } |
| 841 | ;; : : : : } font height / 2 } | 848 | ;; : : : : } font height / 2 } |
| 842 | ;; : : : :........... } | 849 | ;; : : : :........... } |
| 843 | ;; : : : } text width } width | 850 | ;; : : : } text width } width |
| 844 | ;; : : :.................. } | 851 | ;; : : :.................. } |
| 845 | ;; : : } font height / 2 } | 852 | ;; : : } font height / 2 } |
| 846 | ;; : :...................... } | 853 | ;; : :...................... } |
| 847 | ;; : } font height } | 854 | ;; : } font height + extra } |
| 848 | ;; :............................................. | 855 | ;; :................................................. |
| 849 | ;; | 856 | ;; |
| 850 | ;; | 857 | ;; |
| 851 | ;; * OPTIONAL | 858 | ;; * OPTIONAL |
| @@ -976,21 +983,21 @@ Please send all bug fixes and enhancements to | |||
| 976 | ;; : | : : : : | : } font height / 2 } | 983 | ;; : | : : : : | : } font height / 2 } |
| 977 | ;; : +================+...:............................... | 984 | ;; : +================+...:............................... |
| 978 | ;; : : : : : : : : | 985 | ;; : : : : : : : : |
| 979 | ;; : : : : : : : :...................... | 986 | ;; : : : : : : : :.......................... |
| 980 | ;; : : : : : : : } font height } | 987 | ;; : : : : : : : } font height } |
| 981 | ;; : : : : : : :....... } | 988 | ;; : : : : : : :....... } |
| 982 | ;; : : : : : : } font height / 2 } | 989 | ;; : : : : : : } font height / 2 } |
| 983 | ;; : : : : : :........... } | 990 | ;; : : : : : :........... } |
| 984 | ;; : : : : : } X width } | 991 | ;; : : : : : } X width } |
| 985 | ;; : : : : :............... } | 992 | ;; : : : : :............... } |
| 986 | ;; : : : : } font height / 2 } width | 993 | ;; : : : : } font height / 2 } width |
| 987 | ;; : : : :.................. } | 994 | ;; : : : :.................. } |
| 988 | ;; : : : } text width } | 995 | ;; : : : } text width } |
| 989 | ;; : : :..................... } | 996 | ;; : : :..................... } |
| 990 | ;; : : } font height / 2 } | 997 | ;; : : } font height / 2 } |
| 991 | ;; : :........................ } | 998 | ;; : :........................ } |
| 992 | ;; : } font height } | 999 | ;; : } font height + extra } |
| 993 | ;; :............................................... | 1000 | ;; :................................................... |
| 994 | ;; | 1001 | ;; |
| 995 | ;; | 1002 | ;; |
| 996 | ;; * EXCEPT | 1003 | ;; * EXCEPT |
| @@ -1003,21 +1010,21 @@ Please send all bug fixes and enhancements to | |||
| 1003 | ;; : | : : : : | : } font height / 2 } | 1010 | ;; : | : : : : | : } font height / 2 } |
| 1004 | ;; : +==================+...:............................... | 1011 | ;; : +==================+...:............................... |
| 1005 | ;; : : : : : : : : | 1012 | ;; : : : : : : : : |
| 1006 | ;; : : : : : : : :...................... | 1013 | ;; : : : : : : : :.......................... |
| 1007 | ;; : : : : : : : } font height } | 1014 | ;; : : : : : : : } font height } |
| 1008 | ;; : : : : : : :....... } | 1015 | ;; : : : : : : :....... } |
| 1009 | ;; : : : : : : } font height / 2 } | 1016 | ;; : : : : : : } font height / 2 } |
| 1010 | ;; : : : : : :........... } | 1017 | ;; : : : : : :........... } |
| 1011 | ;; : : : : : } Y width } | 1018 | ;; : : : : : } Y width } |
| 1012 | ;; : : : : :............... } | 1019 | ;; : : : : :............... } |
| 1013 | ;; : : : : } font height } width | 1020 | ;; : : : : } font height } width |
| 1014 | ;; : : : :................... } | 1021 | ;; : : : :................... } |
| 1015 | ;; : : : } X width } | 1022 | ;; : : : } X width } |
| 1016 | ;; : : :....................... } | 1023 | ;; : : :....................... } |
| 1017 | ;; : : } font height / 2 } | 1024 | ;; : : } font height / 2 } |
| 1018 | ;; : :.......................... } | 1025 | ;; : :.......................... } |
| 1019 | ;; : } font height } | 1026 | ;; : } font height + extra } |
| 1020 | ;; :................................................. | 1027 | ;; :..................................................... |
| 1021 | ;; | 1028 | ;; |
| 1022 | ;; NOTE: If Y element is empty, it's draw nothing at Y place. | 1029 | ;; NOTE: If Y element is empty, it's draw nothing at Y place. |
| 1023 | ;; | 1030 | ;; |
| @@ -1089,7 +1096,8 @@ Please send all bug fixes and enhancements to | |||
| 1089 | ;; ---------------- | 1096 | ;; ---------------- |
| 1090 | ;; | 1097 | ;; |
| 1091 | ;; Thanks to Drew Adams <drew.adams@oracle.com> for suggestions: | 1098 | ;; Thanks to Drew Adams <drew.adams@oracle.com> for suggestions: |
| 1092 | ;; - `ebnf-production-name-p', `ebnf-stop-on-error', | 1099 | ;; - `ebnf-arrow-extra-width', `ebnf-arrow-scale', |
| 1100 | ;; `ebnf-production-name-p', `ebnf-stop-on-error', | ||
| 1093 | ;; `ebnf-file-suffix-regexp'and `ebnf-special-show-delimiter' variables. | 1101 | ;; `ebnf-file-suffix-regexp'and `ebnf-special-show-delimiter' variables. |
| 1094 | ;; - `ebnf-delete-style', `ebnf-eps-file' and `ebnf-eps-directory' | 1102 | ;; - `ebnf-delete-style', `ebnf-eps-file' and `ebnf-eps-directory' |
| 1095 | ;; commands. | 1103 | ;; commands. |
| @@ -1911,6 +1919,29 @@ special." | |||
| 1911 | :group 'ebnf2ps) | 1919 | :group 'ebnf2ps) |
| 1912 | 1920 | ||
| 1913 | 1921 | ||
| 1922 | (defcustom ebnf-arrow-extra-width | ||
| 1923 | (if (eq ebnf-arrow-shape 'none) | ||
| 1924 | 0.0 | ||
| 1925 | (* (sqrt 5.0) 0.65 ebnf-line-width)) | ||
| 1926 | "*Specify extra width for arrow shape drawing. | ||
| 1927 | |||
| 1928 | The extra width is used to avoid that the arrowhead and the terminal border | ||
| 1929 | overlap. It depens on `ebnf-arrow-shape' and `ebnf-line-width'." | ||
| 1930 | :type 'number | ||
| 1931 | :version "22" | ||
| 1932 | :group 'ebnf-shape) | ||
| 1933 | |||
| 1934 | |||
| 1935 | (defcustom ebnf-arrow-scale 1.0 | ||
| 1936 | "*Specify the arrow scale. | ||
| 1937 | |||
| 1938 | Values lower than 1.0, shrink the arrow. | ||
| 1939 | Values greater than 1.0, expand the arrow." | ||
| 1940 | :type 'number | ||
| 1941 | :version "22" | ||
| 1942 | :group 'ebnf-shape) | ||
| 1943 | |||
| 1944 | |||
| 1914 | (defcustom ebnf-debug-ps nil | 1945 | (defcustom ebnf-debug-ps nil |
| 1915 | "*Non-nil means to generate PostScript debug procedures. | 1946 | "*Non-nil means to generate PostScript debug procedures. |
| 1916 | 1947 | ||
| @@ -2859,9 +2890,9 @@ See documentation for `ebnf-terminal-shape', `ebnf-non-terminal-shape' and | |||
| 2859 | /HeightNT FontHeight FontHeight add def | 2890 | /HeightNT FontHeight FontHeight add def |
| 2860 | 2891 | ||
| 2861 | /T HeightT HeightNT add 0.5 mul def | 2892 | /T HeightT HeightNT add 0.5 mul def |
| 2862 | /hT T 0.5 mul def | 2893 | /hT T 0.5 mul def |
| 2863 | /hT2 hT 0.5 mul def | 2894 | /hT2 hT 0.5 mul ArrowScale mul def |
| 2864 | /hT4 hT 0.25 mul def | 2895 | /hT4 hT 0.25 mul ArrowScale mul def |
| 2865 | 2896 | ||
| 2866 | /Er 0.1 def % Error factor | 2897 | /Er 0.1 def % Error factor |
| 2867 | 2898 | ||
| @@ -2947,6 +2978,7 @@ See documentation for `ebnf-terminal-shape', `ebnf-non-terminal-shape' and | |||
| 2947 | RA-vector ArrowShape get exec | 2978 | RA-vector ArrowShape get exec |
| 2948 | Gstroke | 2979 | Gstroke |
| 2949 | moveto | 2980 | moveto |
| 2981 | ExtraWidth 0 rmoveto | ||
| 2950 | }def | 2982 | }def |
| 2951 | 2983 | ||
| 2952 | % rotation DrawArrow | 2984 | % rotation DrawArrow |
| @@ -3245,7 +3277,7 @@ See documentation for `ebnf-terminal-shape', `ebnf-non-terminal-shape' and | |||
| 3245 | % string width prepare-width |- string | 3277 | % string width prepare-width |- string |
| 3246 | /prepare-width | 3278 | /prepare-width |
| 3247 | {/width exch def | 3279 | {/width exch def |
| 3248 | dup stringwidth pop space add space add width exch sub 0.5 mul | 3280 | dup stringwidth pop space add space add width exch sub ExtraWidth sub 0.5 mul |
| 3249 | /w exch def | 3281 | /w exch def |
| 3250 | }def | 3282 | }def |
| 3251 | 3283 | ||
| @@ -4877,7 +4909,6 @@ killed after process termination." | |||
| 4877 | (progn | 4909 | (progn |
| 4878 | ;; adjust creator comment | 4910 | ;; adjust creator comment |
| 4879 | (end-of-line) | 4911 | (end-of-line) |
| 4880 | (backward-char) | ||
| 4881 | (insert " & ebnf2ps v" ebnf-version) | 4912 | (insert " & ebnf2ps v" ebnf-version) |
| 4882 | ;; insert ebnf settings & engine | 4913 | ;; insert ebnf settings & engine |
| 4883 | (goto-char (point-max)) | 4914 | (goto-char (point-max)) |
| @@ -5066,6 +5097,10 @@ killed after process termination." | |||
| 5066 | (format "/ShadowR %s def\n" | 5097 | (format "/ShadowR %s def\n" |
| 5067 | (ebnf-boolean ebnf-repeat-shadow)) | 5098 | (ebnf-boolean ebnf-repeat-shadow)) |
| 5068 | ;; miscellaneous | 5099 | ;; miscellaneous |
| 5100 | (format "/ExtraWidth %s def\n" | ||
| 5101 | (ebnf-format-float ebnf-arrow-extra-width)) | ||
| 5102 | (format "/ArrowScale %s def\n" | ||
| 5103 | (ebnf-format-float ebnf-arrow-scale)) | ||
| 5069 | (format "/DefaultWidth %s def\n" | 5104 | (format "/DefaultWidth %s def\n" |
| 5070 | (ebnf-format-float ebnf-default-width)) | 5105 | (ebnf-format-float ebnf-default-width)) |
| 5071 | (format "/LineWidth %s def\n" | 5106 | (format "/LineWidth %s def\n" |
| @@ -5152,7 +5187,7 @@ killed after process termination." | |||
| 5152 | (len (length (ebnf-node-name node)))) | 5187 | (len (length (ebnf-node-name node)))) |
| 5153 | (ebnf-node-entry node (* height 0.5)) | 5188 | (ebnf-node-entry node (* height 0.5)) |
| 5154 | (ebnf-node-height node height) | 5189 | (ebnf-node-height node height) |
| 5155 | (ebnf-node-width node (+ ebnf-basic-width space | 5190 | (ebnf-node-width node (+ ebnf-basic-width ebnf-arrow-extra-width space |
| 5156 | (* len font-width) | 5191 | (* len font-width) |
| 5157 | space ebnf-basic-width)))) | 5192 | space ebnf-basic-width)))) |
| 5158 | 5193 | ||
| @@ -5173,6 +5208,7 @@ killed after process termination." | |||
| 5173 | ebnf-font-height-S) | 5208 | ebnf-font-height-S) |
| 5174 | ebnf-space-R ebnf-space-R)) | 5209 | ebnf-space-R ebnf-space-R)) |
| 5175 | (ebnf-node-width repeat (+ (ebnf-node-width element) | 5210 | (ebnf-node-width repeat (+ (ebnf-node-width element) |
| 5211 | ebnf-arrow-extra-width | ||
| 5176 | ebnf-space-R ebnf-space-R ebnf-space-R | 5212 | ebnf-space-R ebnf-space-R ebnf-space-R |
| 5177 | ebnf-horizontal-space | 5213 | ebnf-horizontal-space |
| 5178 | (* (length times) ebnf-font-width-R))))) | 5214 | (* (length times) ebnf-font-width-R))))) |
| @@ -5194,6 +5230,7 @@ killed after process termination." | |||
| 5194 | ebnf-space-E ebnf-space-E)) | 5230 | ebnf-space-E ebnf-space-E)) |
| 5195 | (ebnf-node-width except (+ (ebnf-node-width factor) | 5231 | (ebnf-node-width except (+ (ebnf-node-width factor) |
| 5196 | (ebnf-node-width element) | 5232 | (ebnf-node-width element) |
| 5233 | ebnf-arrow-extra-width | ||
| 5197 | ebnf-space-E ebnf-space-E | 5234 | ebnf-space-E ebnf-space-E |
| 5198 | ebnf-space-E ebnf-space-E | 5235 | ebnf-space-E ebnf-space-E |
| 5199 | ebnf-font-width-E | 5236 | ebnf-font-width-E |
diff --git a/lisp/progmodes/gdb-ui.el b/lisp/progmodes/gdb-ui.el index f45bb2fe524..52360a73970 100644 --- a/lisp/progmodes/gdb-ui.el +++ b/lisp/progmodes/gdb-ui.el | |||
| @@ -782,7 +782,7 @@ With arg, enter name of variable to be watched in the minibuffer." | |||
| 782 | 782 | ||
| 783 | (defconst gdb-var-list-children-regexp | 783 | (defconst gdb-var-list-children-regexp |
| 784 | "child={.*?name=\"\\(.*?\\)\",.*?exp=\"\\(.*?\\)\",.*?\ | 784 | "child={.*?name=\"\\(.*?\\)\",.*?exp=\"\\(.*?\\)\",.*?\ |
| 785 | numchild=\"\\(.*?\\)\",.*?type=\"\\(.*?\\)\".*?}") | 785 | numchild=\"\\(.*?\\)\"\\(}\\|,.*?\\(type=\"\\(.*?\\)\"\\)?.*?}\\)") |
| 786 | 786 | ||
| 787 | (defun gdb-var-list-children-handler (varnum) | 787 | (defun gdb-var-list-children-handler (varnum) |
| 788 | (goto-char (point-min)) | 788 | (goto-char (point-min)) |
| @@ -796,7 +796,7 @@ numchild=\"\\(.*?\\)\",.*?type=\"\\(.*?\\)\".*?}") | |||
| 796 | (let ((varchild (list (match-string 1) | 796 | (let ((varchild (list (match-string 1) |
| 797 | (match-string 2) | 797 | (match-string 2) |
| 798 | (match-string 3) | 798 | (match-string 3) |
| 799 | (match-string 4) | 799 | (match-string 6) |
| 800 | nil nil))) | 800 | nil nil))) |
| 801 | (if (assoc (car varchild) gdb-var-list) | 801 | (if (assoc (car varchild) gdb-var-list) |
| 802 | (throw 'child-already-watched nil)) | 802 | (throw 'child-already-watched nil)) |
| @@ -902,20 +902,23 @@ Changed values are highlighted with the face `font-lock-warning-face'." | |||
| 902 | TEXT is the text of the button we clicked on, a + or - item. | 902 | TEXT is the text of the button we clicked on, a + or - item. |
| 903 | TOKEN is data related to this node. | 903 | TOKEN is data related to this node. |
| 904 | INDENT is the current indentation depth." | 904 | INDENT is the current indentation depth." |
| 905 | (cond ((string-match "+" text) ;expand this node | 905 | (if (and gud-comint-buffer (buffer-name gud-comint-buffer)) |
| 906 | (if (and | 906 | (progn |
| 907 | (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba) | 907 | (cond ((string-match "+" text) ;expand this node |
| 908 | (string-equal gdb-version "pre-6.4")) | 908 | (if (and (eq (buffer-local-value |
| 909 | (gdb-var-list-children token) | 909 | 'gud-minor-mode gud-comint-buffer) 'gdba) |
| 910 | (gdb-var-list-children-1 token))) | 910 | (string-equal gdb-version "pre-6.4")) |
| 911 | ((string-match "-" text) ;contract this node | 911 | (gdb-var-list-children token) |
| 912 | (dolist (var gdb-var-list) | 912 | (gdb-var-list-children-1 token))) |
| 913 | (if (string-match (concat token "\\.") (car var)) | 913 | ((string-match "-" text) ;contract this node |
| 914 | (setq gdb-var-list (delq var gdb-var-list)))) | 914 | (dolist (var gdb-var-list) |
| 915 | (speedbar-change-expand-button-char ?+) | 915 | (if (string-match (concat token "\\.") (car var)) |
| 916 | (speedbar-delete-subblock indent)) | 916 | (setq gdb-var-list (delq var gdb-var-list)))) |
| 917 | (t (error "Ooops... not sure what to do"))) | 917 | (speedbar-change-expand-button-char ?+) |
| 918 | (speedbar-center-buffer-smartly)) | 918 | (speedbar-delete-subblock indent)) |
| 919 | (t (error "Ooops... not sure what to do"))) | ||
| 920 | (speedbar-center-buffer-smartly)) | ||
| 921 | (message-box "GUD session has been killed"))) | ||
| 919 | 922 | ||
| 920 | (defun gdb-get-target-string () | 923 | (defun gdb-get-target-string () |
| 921 | (with-current-buffer gud-comint-buffer | 924 | (with-current-buffer gud-comint-buffer |
| @@ -1132,7 +1135,7 @@ This filter may simply queue input for a later time." | |||
| 1132 | (if gdb-prompting | 1135 | (if gdb-prompting |
| 1133 | (progn | 1136 | (progn |
| 1134 | (gdb-send-item item) | 1137 | (gdb-send-item item) |
| 1135 | (setq gdb-prompting nil)) | 1138 | (setq gdb-prompting nil)) |
| 1136 | (push item gdb-input-queue)))) | 1139 | (push item gdb-input-queue)))) |
| 1137 | 1140 | ||
| 1138 | (defun gdb-dequeue-input () | 1141 | (defun gdb-dequeue-input () |
| @@ -3346,7 +3349,8 @@ is set in them." | |||
| 3346 | 3349 | ||
| 3347 | (defconst gdb-var-list-children-regexp-1 | 3350 | (defconst gdb-var-list-children-regexp-1 |
| 3348 | "child={.*?name=\"\\(.+?\\)\",.*?exp=\"\\(.+?\\)\",.*?\ | 3351 | "child={.*?name=\"\\(.+?\\)\",.*?exp=\"\\(.+?\\)\",.*?\ |
| 3349 | numchild=\"\\(.+?\\)\",.*?value=\\(\".*?\"\\),.*?type=\"\\(.+?\\)\".*?}") | 3352 | numchild=\"\\(.+?\\)\",.*?value=\\(\".*?\"\\)\ |
| 3353 | \\(}\\|,.*?\\(type=\"\\(.+?\\)\"\\)?.*?}\\)") | ||
| 3350 | 3354 | ||
| 3351 | (defun gdb-var-list-children-handler-1 (varnum) | 3355 | (defun gdb-var-list-children-handler-1 (varnum) |
| 3352 | (goto-char (point-min)) | 3356 | (goto-char (point-min)) |
| @@ -3360,7 +3364,7 @@ numchild=\"\\(.+?\\)\",.*?value=\\(\".*?\"\\),.*?type=\"\\(.+?\\)\".*?}") | |||
| 3360 | (let ((varchild (list (match-string 1) | 3364 | (let ((varchild (list (match-string 1) |
| 3361 | (match-string 2) | 3365 | (match-string 2) |
| 3362 | (match-string 3) | 3366 | (match-string 3) |
| 3363 | (match-string 5) | 3367 | (match-string 7) |
| 3364 | (read (match-string 4)) | 3368 | (read (match-string 4)) |
| 3365 | nil))) | 3369 | nil))) |
| 3366 | (if (assoc (car varchild) gdb-var-list) | 3370 | (if (assoc (car varchild) gdb-var-list) |
diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index 84b40e8ba80..b42e1b7fdc7 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el | |||
| @@ -456,8 +456,8 @@ required by the caller." | |||
| 456 | (while var-list | 456 | (while var-list |
| 457 | (let* (char (depth 0) (start 0) (var (car var-list)) | 457 | (let* (char (depth 0) (start 0) (var (car var-list)) |
| 458 | (varnum (car var)) (expr (nth 1 var)) | 458 | (varnum (car var)) (expr (nth 1 var)) |
| 459 | (type (nth 3 var)) (value (nth 4 var)) | 459 | (type (if (nth 3 var) (nth 3 var) " ")) |
| 460 | (status (nth 5 var))) | 460 | (value (nth 4 var)) (status (nth 5 var))) |
| 461 | (put-text-property | 461 | (put-text-property |
| 462 | 0 (length expr) 'face font-lock-variable-name-face expr) | 462 | 0 (length expr) 'face font-lock-variable-name-face expr) |
| 463 | (put-text-property | 463 | (put-text-property |
diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el index 2f26c90ac21..52cfa602e59 100644 --- a/lisp/progmodes/idlwave.el +++ b/lisp/progmodes/idlwave.el | |||
| @@ -75,7 +75,7 @@ | |||
| 75 | ;; of the documentation is available from the maintainers webpage (see | 75 | ;; of the documentation is available from the maintainers webpage (see |
| 76 | ;; SOURCE). | 76 | ;; SOURCE). |
| 77 | ;; | 77 | ;; |
| 78 | ;; | 78 | ;; |
| 79 | ;; ACKNOWLEDGMENTS | 79 | ;; ACKNOWLEDGMENTS |
| 80 | ;; =============== | 80 | ;; =============== |
| 81 | ;; | 81 | ;; |
| @@ -125,7 +125,7 @@ | |||
| 125 | ;; up inserting the character that expanded the abbrev after moving | 125 | ;; up inserting the character that expanded the abbrev after moving |
| 126 | ;; point backward, e.g., "\cl" expanded with a space becomes | 126 | ;; point backward, e.g., "\cl" expanded with a space becomes |
| 127 | ;; "LONG( )" with point before the close paren. This is solved by | 127 | ;; "LONG( )" with point before the close paren. This is solved by |
| 128 | ;; using a temporary function in `post-command-hook' - not pretty, | 128 | ;; using a temporary function in `post-command-hook' - not pretty, |
| 129 | ;; but it works. | 129 | ;; but it works. |
| 130 | ;; | 130 | ;; |
| 131 | ;; Tabs and spaces are treated equally as whitespace when filling a | 131 | ;; Tabs and spaces are treated equally as whitespace when filling a |
| @@ -178,13 +178,13 @@ | |||
| 178 | nil ;; We've got what we needed | 178 | nil ;; We've got what we needed |
| 179 | ;; We have the old or no custom-library, hack around it! | 179 | ;; We have the old or no custom-library, hack around it! |
| 180 | (defmacro defgroup (&rest args) nil) | 180 | (defmacro defgroup (&rest args) nil) |
| 181 | (defmacro defcustom (var value doc &rest args) | 181 | (defmacro defcustom (var value doc &rest args) |
| 182 | `(defvar ,var ,value ,doc)))) | 182 | `(defvar ,var ,value ,doc)))) |
| 183 | 183 | ||
| 184 | (defgroup idlwave nil | 184 | (defgroup idlwave nil |
| 185 | "Major mode for editing IDL .pro files." | 185 | "Major mode for editing IDL .pro files." |
| 186 | :tag "IDLWAVE" | 186 | :tag "IDLWAVE" |
| 187 | :link '(url-link :tag "Home Page" | 187 | :link '(url-link :tag "Home Page" |
| 188 | "http://idlwave.org") | 188 | "http://idlwave.org") |
| 189 | :link '(emacs-commentary-link :tag "Commentary in idlw-shell.el" | 189 | :link '(emacs-commentary-link :tag "Commentary in idlw-shell.el" |
| 190 | "idlw-shell.el") | 190 | "idlw-shell.el") |
| @@ -298,8 +298,8 @@ extends to the end of the match for the regular expression." | |||
| 298 | 298 | ||
| 299 | (defcustom idlwave-auto-fill-split-string t | 299 | (defcustom idlwave-auto-fill-split-string t |
| 300 | "*If non-nil then auto fill will split strings with the IDL `+' operator. | 300 | "*If non-nil then auto fill will split strings with the IDL `+' operator. |
| 301 | When the line end falls within a string, string concatenation with the | 301 | When the line end falls within a string, string concatenation with the |
| 302 | '+' operator will be used to distribute a long string over lines. | 302 | '+' operator will be used to distribute a long string over lines. |
| 303 | If nil and a string is split then a terminal beep and warning are issued. | 303 | If nil and a string is split then a terminal beep and warning are issued. |
| 304 | 304 | ||
| 305 | This variable is ignored when `idlwave-fill-comment-line-only' is | 305 | This variable is ignored when `idlwave-fill-comment-line-only' is |
| @@ -418,7 +418,7 @@ t All available | |||
| 418 | (const :tag "When saving a buffer" save-buffer) | 418 | (const :tag "When saving a buffer" save-buffer) |
| 419 | (const :tag "After a buffer was killed" kill-buffer) | 419 | (const :tag "After a buffer was killed" kill-buffer) |
| 420 | (const :tag "After a buffer was compiled successfully, update shell info" compile-buffer)))) | 420 | (const :tag "After a buffer was compiled successfully, update shell info" compile-buffer)))) |
| 421 | 421 | ||
| 422 | (defcustom idlwave-rinfo-max-source-lines 5 | 422 | (defcustom idlwave-rinfo-max-source-lines 5 |
| 423 | "*Maximum number of source files displayed in the Routine Info window. | 423 | "*Maximum number of source files displayed in the Routine Info window. |
| 424 | When an integer, it is the maximum number of source files displayed. | 424 | When an integer, it is the maximum number of source files displayed. |
| @@ -453,7 +453,7 @@ value of `!DIR'. See also `idlwave-library-path'." | |||
| 453 | :type 'directory) | 453 | :type 'directory) |
| 454 | 454 | ||
| 455 | ;; Configuration files | 455 | ;; Configuration files |
| 456 | (defcustom idlwave-config-directory | 456 | (defcustom idlwave-config-directory |
| 457 | (convert-standard-filename "~/.idlwave") | 457 | (convert-standard-filename "~/.idlwave") |
| 458 | "*Directory for configuration files and user-library catalog." | 458 | "*Directory for configuration files and user-library catalog." |
| 459 | :group 'idlwave-routine-info | 459 | :group 'idlwave-routine-info |
| @@ -469,7 +469,7 @@ value of `!DIR'. See also `idlwave-library-path'." | |||
| 469 | (defcustom idlwave-special-lib-alist nil | 469 | (defcustom idlwave-special-lib-alist nil |
| 470 | "Alist of regular expressions matching special library directories. | 470 | "Alist of regular expressions matching special library directories. |
| 471 | When listing routine source locations, IDLWAVE gives a short hint where | 471 | When listing routine source locations, IDLWAVE gives a short hint where |
| 472 | the file defining the routine is located. By default it lists `SystemLib' | 472 | the file defining the routine is located. By default it lists `SystemLib' |
| 473 | for routines in the system library `!DIR/lib' and `Library' for anything | 473 | for routines in the system library `!DIR/lib' and `Library' for anything |
| 474 | else. This variable can define additional types. The car of each entry | 474 | else. This variable can define additional types. The car of each entry |
| 475 | is a regular expression matching the file name (they normally will match | 475 | is a regular expression matching the file name (they normally will match |
| @@ -480,7 +480,7 @@ chars are allowed." | |||
| 480 | (cons regexp string))) | 480 | (cons regexp string))) |
| 481 | 481 | ||
| 482 | (defcustom idlwave-auto-write-paths t | 482 | (defcustom idlwave-auto-write-paths t |
| 483 | "Write out path (!PATH) and system directory (!DIR) info automatically. | 483 | "Write out path (!PATH) and system directory (!DIR) info automatically. |
| 484 | Path info is needed to locate library catalog files. If non-nil, | 484 | Path info is needed to locate library catalog files. If non-nil, |
| 485 | whenever the path-list changes as a result of shell-query, etc., it is | 485 | whenever the path-list changes as a result of shell-query, etc., it is |
| 486 | written to file. Otherwise, the menu option \"Write Paths\" can be | 486 | written to file. Otherwise, the menu option \"Write Paths\" can be |
| @@ -511,7 +511,7 @@ used to force a write." | |||
| 511 | This variable determines the case (UPPER/lower/Capitalized...) of | 511 | This variable determines the case (UPPER/lower/Capitalized...) of |
| 512 | words inserted into the buffer by completion. The preferred case can | 512 | words inserted into the buffer by completion. The preferred case can |
| 513 | be specified separately for routine names, keywords, classes and | 513 | be specified separately for routine names, keywords, classes and |
| 514 | methods. | 514 | methods. |
| 515 | This alist should therefore have entries for `routine' (normal | 515 | This alist should therefore have entries for `routine' (normal |
| 516 | functions and procedures, i.e. non-methods), `keyword', `class', and | 516 | functions and procedures, i.e. non-methods), `keyword', `class', and |
| 517 | `method'. Plausible values are | 517 | `method'. Plausible values are |
| @@ -598,7 +598,7 @@ certain methods this assumption is almost always true. The methods | |||
| 598 | for which to assume this can be set here." | 598 | for which to assume this can be set here." |
| 599 | :group 'idlwave-routine-info | 599 | :group 'idlwave-routine-info |
| 600 | :type '(repeat (regexp :tag "Match method:"))) | 600 | :type '(repeat (regexp :tag "Match method:"))) |
| 601 | 601 | ||
| 602 | 602 | ||
| 603 | (defcustom idlwave-completion-show-classes 1 | 603 | (defcustom idlwave-completion-show-classes 1 |
| 604 | "*Number of classes to show when completing object methods and keywords. | 604 | "*Number of classes to show when completing object methods and keywords. |
| @@ -663,7 +663,7 @@ should contain at least two elements: (method-default . VALUE) and | |||
| 663 | specify if the class should be found during method and keyword | 663 | specify if the class should be found during method and keyword |
| 664 | completion, respectively. | 664 | completion, respectively. |
| 665 | 665 | ||
| 666 | The alist may have additional entries specifying exceptions from the | 666 | The alist may have additional entries specifying exceptions from the |
| 667 | keyword completion rule for specific methods, like INIT or | 667 | keyword completion rule for specific methods, like INIT or |
| 668 | GETPROPERTY. In order to turn on class specification for the INIT | 668 | GETPROPERTY. In order to turn on class specification for the INIT |
| 669 | method, add an entry (\"INIT\" . t). The method name must be ALL-CAPS." | 669 | method, add an entry (\"INIT\" . t). The method name must be ALL-CAPS." |
| @@ -687,7 +687,7 @@ particular object method call. This happens during the commands | |||
| 687 | value of the variable `idlwave-query-class'. | 687 | value of the variable `idlwave-query-class'. |
| 688 | 688 | ||
| 689 | When you specify a class, this information can be stored as a text | 689 | When you specify a class, this information can be stored as a text |
| 690 | property on the `->' arrow in the source code, so that during the same | 690 | property on the `->' arrow in the source code, so that during the same |
| 691 | editing session, IDLWAVE will not have to ask again. When this | 691 | editing session, IDLWAVE will not have to ask again. When this |
| 692 | variable is non-nil, IDLWAVE will store and reuse the class information. | 692 | variable is non-nil, IDLWAVE will store and reuse the class information. |
| 693 | The class stored can be checked and removed with `\\[idlwave-routine-info]' | 693 | The class stored can be checked and removed with `\\[idlwave-routine-info]' |
| @@ -1065,7 +1065,7 @@ IDL process is made." | |||
| 1065 | :group 'idlwave-misc | 1065 | :group 'idlwave-misc |
| 1066 | :type 'boolean) | 1066 | :type 'boolean) |
| 1067 | 1067 | ||
| 1068 | (defcustom idlwave-default-font-lock-items | 1068 | (defcustom idlwave-default-font-lock-items |
| 1069 | '(pros-and-functions batch-files idlwave-idl-keywords label goto | 1069 | '(pros-and-functions batch-files idlwave-idl-keywords label goto |
| 1070 | common-blocks class-arrows) | 1070 | common-blocks class-arrows) |
| 1071 | "Items which should be fontified on the default fontification level 2. | 1071 | "Items which should be fontified on the default fontification level 2. |
| @@ -1127,25 +1127,25 @@ As a user, you should not set this to t.") | |||
| 1127 | ;;; and Carsten Dominik... | 1127 | ;;; and Carsten Dominik... |
| 1128 | 1128 | ||
| 1129 | ;; The following are the reserved words in IDL. Maybe we should | 1129 | ;; The following are the reserved words in IDL. Maybe we should |
| 1130 | ;; highlight some more stuff as well? | 1130 | ;; highlight some more stuff as well? |
| 1131 | ;; Procedure declarations. Fontify keyword plus procedure name. | 1131 | ;; Procedure declarations. Fontify keyword plus procedure name. |
| 1132 | (defvar idlwave-idl-keywords | 1132 | (defvar idlwave-idl-keywords |
| 1133 | ;; To update this regexp, update the list of keywords and | 1133 | ;; To update this regexp, update the list of keywords and |
| 1134 | ;; evaluate the form. | 1134 | ;; evaluate the form. |
| 1135 | ;; (insert | 1135 | ;; (insert |
| 1136 | ;; (prin1-to-string | 1136 | ;; (prin1-to-string |
| 1137 | ;; (concat | 1137 | ;; (concat |
| 1138 | ;; "\\<\\(" | 1138 | ;; "\\<\\(" |
| 1139 | ;; (regexp-opt | 1139 | ;; (regexp-opt |
| 1140 | ;; '("||" "&&" "and" "or" "xor" "not" | 1140 | ;; '("||" "&&" "and" "or" "xor" "not" |
| 1141 | ;; "eq" "ge" "gt" "le" "lt" "ne" | 1141 | ;; "eq" "ge" "gt" "le" "lt" "ne" |
| 1142 | ;; "for" "do" "endfor" | 1142 | ;; "for" "do" "endfor" |
| 1143 | ;; "if" "then" "endif" "else" "endelse" | 1143 | ;; "if" "then" "endif" "else" "endelse" |
| 1144 | ;; "case" "of" "endcase" | 1144 | ;; "case" "of" "endcase" |
| 1145 | ;; "switch" "break" "continue" "endswitch" | 1145 | ;; "switch" "break" "continue" "endswitch" |
| 1146 | ;; "begin" "end" | 1146 | ;; "begin" "end" |
| 1147 | ;; "repeat" "until" "endrep" | 1147 | ;; "repeat" "until" "endrep" |
| 1148 | ;; "while" "endwhile" | 1148 | ;; "while" "endwhile" |
| 1149 | ;; "goto" "return" | 1149 | ;; "goto" "return" |
| 1150 | ;; "inherits" "mod" | 1150 | ;; "inherits" "mod" |
| 1151 | ;; "compile_opt" "forward_function" | 1151 | ;; "compile_opt" "forward_function" |
| @@ -1168,7 +1168,7 @@ As a user, you should not set this to t.") | |||
| 1168 | (2 font-lock-reference-face nil t) ; block name | 1168 | (2 font-lock-reference-face nil t) ; block name |
| 1169 | ("[ \t]*\\(\\sw+\\)[ ,]*" | 1169 | ("[ \t]*\\(\\sw+\\)[ ,]*" |
| 1170 | ;; Start with point after block name and comma | 1170 | ;; Start with point after block name and comma |
| 1171 | (goto-char (match-end 0)) ; needed for XEmacs, could be nil | 1171 | (goto-char (match-end 0)) ; needed for XEmacs, could be nil |
| 1172 | nil | 1172 | nil |
| 1173 | (1 font-lock-variable-name-face) ; variable names | 1173 | (1 font-lock-variable-name-face) ; variable names |
| 1174 | ))) | 1174 | ))) |
| @@ -1223,7 +1223,7 @@ As a user, you should not set this to t.") | |||
| 1223 | ;; All operators (not used because too noisy) | 1223 | ;; All operators (not used because too noisy) |
| 1224 | (all-operators | 1224 | (all-operators |
| 1225 | '("[-*^#+<>/]" (0 font-lock-keyword-face))) | 1225 | '("[-*^#+<>/]" (0 font-lock-keyword-face))) |
| 1226 | 1226 | ||
| 1227 | ;; Arrows with text property `idlwave-class' | 1227 | ;; Arrows with text property `idlwave-class' |
| 1228 | (class-arrows | 1228 | (class-arrows |
| 1229 | '(idlwave-match-class-arrows (0 idlwave-class-arrow-face)))) | 1229 | '(idlwave-match-class-arrows (0 idlwave-class-arrow-face)))) |
| @@ -1260,14 +1260,14 @@ As a user, you should not set this to t.") | |||
| 1260 | 1260 | ||
| 1261 | (defvar idlwave-font-lock-defaults | 1261 | (defvar idlwave-font-lock-defaults |
| 1262 | '((idlwave-font-lock-keywords | 1262 | '((idlwave-font-lock-keywords |
| 1263 | idlwave-font-lock-keywords-1 | 1263 | idlwave-font-lock-keywords-1 |
| 1264 | idlwave-font-lock-keywords-2 | 1264 | idlwave-font-lock-keywords-2 |
| 1265 | idlwave-font-lock-keywords-3) | 1265 | idlwave-font-lock-keywords-3) |
| 1266 | nil t | 1266 | nil t |
| 1267 | ((?$ . "w") (?_ . "w") (?. . "w") (?| . "w") (?& . "w")) | 1267 | ((?$ . "w") (?_ . "w") (?. . "w") (?| . "w") (?& . "w")) |
| 1268 | beginning-of-line)) | 1268 | beginning-of-line)) |
| 1269 | 1269 | ||
| 1270 | (put 'idlwave-mode 'font-lock-defaults | 1270 | (put 'idlwave-mode 'font-lock-defaults |
| 1271 | idlwave-font-lock-defaults) ; XEmacs | 1271 | idlwave-font-lock-defaults) ; XEmacs |
| 1272 | 1272 | ||
| 1273 | (defconst idlwave-comment-line-start-skip "^[ \t]*;" | 1273 | (defconst idlwave-comment-line-start-skip "^[ \t]*;" |
| @@ -1275,7 +1275,7 @@ As a user, you should not set this to t.") | |||
| 1275 | That is the _beginning_ of a line containing a comment delimiter `;' preceded | 1275 | That is the _beginning_ of a line containing a comment delimiter `;' preceded |
| 1276 | only by whitespace.") | 1276 | only by whitespace.") |
| 1277 | 1277 | ||
| 1278 | (defconst idlwave-begin-block-reg | 1278 | (defconst idlwave-begin-block-reg |
| 1279 | "\\<\\(pro\\|function\\|begin\\|case\\|switch\\)\\>" | 1279 | "\\<\\(pro\\|function\\|begin\\|case\\|switch\\)\\>" |
| 1280 | "Regular expression to find the beginning of a block. The case does | 1280 | "Regular expression to find the beginning of a block. The case does |
| 1281 | not matter. The search skips matches in comments.") | 1281 | not matter. The search skips matches in comments.") |
| @@ -1352,17 +1352,17 @@ blocks starting with a BEGIN statement. The matches must have associations | |||
| 1352 | '(goto . ("goto\\>" nil)) | 1352 | '(goto . ("goto\\>" nil)) |
| 1353 | '(case . ("case\\>" nil)) | 1353 | '(case . ("case\\>" nil)) |
| 1354 | '(switch . ("switch\\>" nil)) | 1354 | '(switch . ("switch\\>" nil)) |
| 1355 | (cons 'call (list (concat "\\(" idlwave-variable "\\) *= *" | 1355 | (cons 'call (list (concat "\\(" idlwave-variable "\\) *= *" |
| 1356 | "\\(" idlwave-method-call "\\s *\\)?" | 1356 | "\\(" idlwave-method-call "\\s *\\)?" |
| 1357 | idlwave-identifier | 1357 | idlwave-identifier |
| 1358 | "\\s *(") nil)) | 1358 | "\\s *(") nil)) |
| 1359 | (cons 'call (list (concat | 1359 | (cons 'call (list (concat |
| 1360 | "\\(" idlwave-method-call "\\s *\\)?" | 1360 | "\\(" idlwave-method-call "\\s *\\)?" |
| 1361 | idlwave-identifier | 1361 | idlwave-identifier |
| 1362 | "\\( *\\($\\|\\$\\)\\|\\s *,\\)") nil)) | 1362 | "\\( *\\($\\|\\$\\)\\|\\s *,\\)") nil)) |
| 1363 | (cons 'assign (list (concat | 1363 | (cons 'assign (list (concat |
| 1364 | "\\(" idlwave-variable "\\) *=") nil))) | 1364 | "\\(" idlwave-variable "\\) *=") nil))) |
| 1365 | 1365 | ||
| 1366 | "Associated list of statement matching regular expressions. | 1366 | "Associated list of statement matching regular expressions. |
| 1367 | Each regular expression matches the start of an IDL statement. The | 1367 | Each regular expression matches the start of an IDL statement. The |
| 1368 | first element of each association is a symbol giving the statement | 1368 | first element of each association is a symbol giving the statement |
| @@ -1385,7 +1385,7 @@ the leftover unidentified statements containing an equal sign." ) | |||
| 1385 | ;; Note that this is documented in the v18 manuals as being a string | 1385 | ;; Note that this is documented in the v18 manuals as being a string |
| 1386 | ;; of length one rather than a single character. | 1386 | ;; of length one rather than a single character. |
| 1387 | ;; The code in this file accepts either format for compatibility. | 1387 | ;; The code in this file accepts either format for compatibility. |
| 1388 | (defvar idlwave-comment-indent-char ?\ | 1388 | (defvar idlwave-comment-indent-char ?\ |
| 1389 | "Character to be inserted for IDL comment indentation. | 1389 | "Character to be inserted for IDL comment indentation. |
| 1390 | Normally a space.") | 1390 | Normally a space.") |
| 1391 | 1391 | ||
| @@ -1557,15 +1557,15 @@ Capitalize system variables - action only | |||
| 1557 | (not (equal idlwave-shell-debug-modifiers '()))) | 1557 | (not (equal idlwave-shell-debug-modifiers '()))) |
| 1558 | ;; Bind the debug commands also with the special modifiers. | 1558 | ;; Bind the debug commands also with the special modifiers. |
| 1559 | (let ((shift (memq 'shift idlwave-shell-debug-modifiers)) | 1559 | (let ((shift (memq 'shift idlwave-shell-debug-modifiers)) |
| 1560 | (mods-noshift (delq 'shift | 1560 | (mods-noshift (delq 'shift |
| 1561 | (copy-sequence idlwave-shell-debug-modifiers)))) | 1561 | (copy-sequence idlwave-shell-debug-modifiers)))) |
| 1562 | (define-key idlwave-mode-map | 1562 | (define-key idlwave-mode-map |
| 1563 | (vector (append mods-noshift (list (if shift ?C ?c)))) | 1563 | (vector (append mods-noshift (list (if shift ?C ?c)))) |
| 1564 | 'idlwave-shell-save-and-run) | 1564 | 'idlwave-shell-save-and-run) |
| 1565 | (define-key idlwave-mode-map | 1565 | (define-key idlwave-mode-map |
| 1566 | (vector (append mods-noshift (list (if shift ?B ?b)))) | 1566 | (vector (append mods-noshift (list (if shift ?B ?b)))) |
| 1567 | 'idlwave-shell-break-here) | 1567 | 'idlwave-shell-break-here) |
| 1568 | (define-key idlwave-mode-map | 1568 | (define-key idlwave-mode-map |
| 1569 | (vector (append mods-noshift (list (if shift ?E ?e)))) | 1569 | (vector (append mods-noshift (list (if shift ?E ?e)))) |
| 1570 | 'idlwave-shell-run-region))) | 1570 | 'idlwave-shell-run-region))) |
| 1571 | (define-key idlwave-mode-map "\C-c\C-d\C-c" 'idlwave-shell-save-and-run) | 1571 | (define-key idlwave-mode-map "\C-c\C-d\C-c" 'idlwave-shell-save-and-run) |
| @@ -1602,7 +1602,7 @@ Capitalize system variables - action only | |||
| 1602 | (define-key idlwave-mode-map "\M-\C-i" 'idlwave-complete) | 1602 | (define-key idlwave-mode-map "\M-\C-i" 'idlwave-complete) |
| 1603 | (define-key idlwave-mode-map "\C-c\C-i" 'idlwave-update-routine-info) | 1603 | (define-key idlwave-mode-map "\C-c\C-i" 'idlwave-update-routine-info) |
| 1604 | (define-key idlwave-mode-map "\C-c=" 'idlwave-resolve) | 1604 | (define-key idlwave-mode-map "\C-c=" 'idlwave-resolve) |
| 1605 | (define-key idlwave-mode-map | 1605 | (define-key idlwave-mode-map |
| 1606 | (if (featurep 'xemacs) [(shift button3)] [(shift mouse-3)]) | 1606 | (if (featurep 'xemacs) [(shift button3)] [(shift mouse-3)]) |
| 1607 | 'idlwave-mouse-context-help) | 1607 | 'idlwave-mouse-context-help) |
| 1608 | 1608 | ||
| @@ -1617,7 +1617,7 @@ Capitalize system variables - action only | |||
| 1617 | ;; to go ahead of > and <, so >= and <= will be treated correctly | 1617 | ;; to go ahead of > and <, so >= and <= will be treated correctly |
| 1618 | (idlwave-action-and-binding "=" '(idlwave-expand-equal -1 -1)) | 1618 | (idlwave-action-and-binding "=" '(idlwave-expand-equal -1 -1)) |
| 1619 | 1619 | ||
| 1620 | ;; Actions for > and < are complicated by >=, <=, and ->... | 1620 | ;; Actions for > and < are complicated by >=, <=, and ->... |
| 1621 | (idlwave-action-and-binding "<" '(idlwave-custom-ltgtr-surround nil)) | 1621 | (idlwave-action-and-binding "<" '(idlwave-custom-ltgtr-surround nil)) |
| 1622 | (idlwave-action-and-binding ">" '(idlwave-custom-ltgtr-surround 'gtr)) | 1622 | (idlwave-action-and-binding ">" '(idlwave-custom-ltgtr-surround 'gtr)) |
| 1623 | 1623 | ||
| @@ -1650,7 +1650,7 @@ idlwave-mode-abbrev-table unless TABLE is non-nil." | |||
| 1650 | (error (apply 'define-abbrev args))))) | 1650 | (error (apply 'define-abbrev args))))) |
| 1651 | 1651 | ||
| 1652 | (condition-case nil | 1652 | (condition-case nil |
| 1653 | (modify-syntax-entry (string-to-char idlwave-abbrev-start-char) | 1653 | (modify-syntax-entry (string-to-char idlwave-abbrev-start-char) |
| 1654 | "w" idlwave-mode-syntax-table) | 1654 | "w" idlwave-mode-syntax-table) |
| 1655 | (error nil)) | 1655 | (error nil)) |
| 1656 | 1656 | ||
| @@ -1774,7 +1774,7 @@ idlwave-mode-abbrev-table unless TABLE is non-nil." | |||
| 1774 | (defvar imenu-extract-index-name-function) | 1774 | (defvar imenu-extract-index-name-function) |
| 1775 | (defvar imenu-prev-index-position-function) | 1775 | (defvar imenu-prev-index-position-function) |
| 1776 | ;; defined later - so just make the compiler hush | 1776 | ;; defined later - so just make the compiler hush |
| 1777 | (defvar idlwave-mode-menu) | 1777 | (defvar idlwave-mode-menu) |
| 1778 | (defvar idlwave-mode-debug-menu) | 1778 | (defvar idlwave-mode-debug-menu) |
| 1779 | 1779 | ||
| 1780 | ;;;###autoload | 1780 | ;;;###autoload |
| @@ -1858,7 +1858,7 @@ The main features of this mode are | |||
| 1858 | \\i IF statement template | 1858 | \\i IF statement template |
| 1859 | \\elif IF-ELSE statement template | 1859 | \\elif IF-ELSE statement template |
| 1860 | \\b BEGIN | 1860 | \\b BEGIN |
| 1861 | 1861 | ||
| 1862 | For a full list, use \\[idlwave-list-abbrevs]. Some templates also | 1862 | For a full list, use \\[idlwave-list-abbrevs]. Some templates also |
| 1863 | have direct keybindings - see the list of keybindings below. | 1863 | have direct keybindings - see the list of keybindings below. |
| 1864 | 1864 | ||
| @@ -1900,19 +1900,19 @@ The main features of this mode are | |||
| 1900 | 1900 | ||
| 1901 | (interactive) | 1901 | (interactive) |
| 1902 | (kill-all-local-variables) | 1902 | (kill-all-local-variables) |
| 1903 | 1903 | ||
| 1904 | (if idlwave-startup-message | 1904 | (if idlwave-startup-message |
| 1905 | (message "Emacs IDLWAVE mode version %s." idlwave-mode-version)) | 1905 | (message "Emacs IDLWAVE mode version %s." idlwave-mode-version)) |
| 1906 | (setq idlwave-startup-message nil) | 1906 | (setq idlwave-startup-message nil) |
| 1907 | 1907 | ||
| 1908 | (setq local-abbrev-table idlwave-mode-abbrev-table) | 1908 | (setq local-abbrev-table idlwave-mode-abbrev-table) |
| 1909 | (set-syntax-table idlwave-mode-syntax-table) | 1909 | (set-syntax-table idlwave-mode-syntax-table) |
| 1910 | 1910 | ||
| 1911 | (set (make-local-variable 'indent-line-function) 'idlwave-indent-and-action) | 1911 | (set (make-local-variable 'indent-line-function) 'idlwave-indent-and-action) |
| 1912 | 1912 | ||
| 1913 | (make-local-variable idlwave-comment-indent-function) | 1913 | (make-local-variable idlwave-comment-indent-function) |
| 1914 | (set idlwave-comment-indent-function 'idlwave-comment-hook) | 1914 | (set idlwave-comment-indent-function 'idlwave-comment-hook) |
| 1915 | 1915 | ||
| 1916 | (set (make-local-variable 'comment-start-skip) ";+[ \t]*") | 1916 | (set (make-local-variable 'comment-start-skip) ";+[ \t]*") |
| 1917 | (set (make-local-variable 'comment-start) ";") | 1917 | (set (make-local-variable 'comment-start) ";") |
| 1918 | (set (make-local-variable 'comment-add) 1) ; ";;" for new and regions | 1918 | (set (make-local-variable 'comment-add) 1) ; ";;" for new and regions |
| @@ -1920,7 +1920,7 @@ The main features of this mode are | |||
| 1920 | (set (make-local-variable 'abbrev-all-caps) t) | 1920 | (set (make-local-variable 'abbrev-all-caps) t) |
| 1921 | (set (make-local-variable 'indent-tabs-mode) nil) | 1921 | (set (make-local-variable 'indent-tabs-mode) nil) |
| 1922 | (set (make-local-variable 'completion-ignore-case) t) | 1922 | (set (make-local-variable 'completion-ignore-case) t) |
| 1923 | 1923 | ||
| 1924 | (use-local-map idlwave-mode-map) | 1924 | (use-local-map idlwave-mode-map) |
| 1925 | 1925 | ||
| 1926 | (when (featurep 'easymenu) | 1926 | (when (featurep 'easymenu) |
| @@ -1930,11 +1930,11 @@ The main features of this mode are | |||
| 1930 | (setq mode-name "IDLWAVE") | 1930 | (setq mode-name "IDLWAVE") |
| 1931 | (setq major-mode 'idlwave-mode) | 1931 | (setq major-mode 'idlwave-mode) |
| 1932 | (setq abbrev-mode t) | 1932 | (setq abbrev-mode t) |
| 1933 | 1933 | ||
| 1934 | (set (make-local-variable idlwave-fill-function) 'idlwave-auto-fill) | 1934 | (set (make-local-variable idlwave-fill-function) 'idlwave-auto-fill) |
| 1935 | (setq comment-end "") | 1935 | (setq comment-end "") |
| 1936 | (set (make-local-variable 'comment-multi-line) nil) | 1936 | (set (make-local-variable 'comment-multi-line) nil) |
| 1937 | (set (make-local-variable 'paragraph-separate) | 1937 | (set (make-local-variable 'paragraph-separate) |
| 1938 | "[ \t\f]*$\\|[ \t]*;+[ \t]*$\\|;+[+=-_*]+$") | 1938 | "[ \t\f]*$\\|[ \t]*;+[ \t]*$\\|;+[+=-_*]+$") |
| 1939 | (set (make-local-variable 'paragraph-start) "[ \t\f]\\|[ \t]*;+[ \t]") | 1939 | (set (make-local-variable 'paragraph-start) "[ \t\f]\\|[ \t]*;+[ \t]") |
| 1940 | (set (make-local-variable 'paragraph-ignore-fill-prefix) nil) | 1940 | (set (make-local-variable 'paragraph-ignore-fill-prefix) nil) |
| @@ -1943,7 +1943,7 @@ The main features of this mode are | |||
| 1943 | ;; Set tag table list to use IDLTAGS as file name. | 1943 | ;; Set tag table list to use IDLTAGS as file name. |
| 1944 | (if (boundp 'tag-table-alist) | 1944 | (if (boundp 'tag-table-alist) |
| 1945 | (add-to-list 'tag-table-alist '("\\.pro$" . "IDLTAGS"))) | 1945 | (add-to-list 'tag-table-alist '("\\.pro$" . "IDLTAGS"))) |
| 1946 | 1946 | ||
| 1947 | ;; Font-lock additions - originally Phil Williams, then Ulrik Dickow | 1947 | ;; Font-lock additions - originally Phil Williams, then Ulrik Dickow |
| 1948 | ;; Following line is for Emacs - XEmacs uses the corresponding property | 1948 | ;; Following line is for Emacs - XEmacs uses the corresponding property |
| 1949 | ;; on the `idlwave-mode' symbol. | 1949 | ;; on the `idlwave-mode' symbol. |
| @@ -1968,7 +1968,7 @@ The main features of this mode are | |||
| 1968 | idlwave-end-block-reg | 1968 | idlwave-end-block-reg |
| 1969 | ";" | 1969 | ";" |
| 1970 | 'idlwave-forward-block nil)) | 1970 | 'idlwave-forward-block nil)) |
| 1971 | 1971 | ||
| 1972 | 1972 | ||
| 1973 | ;; Make a local post-command-hook and add our hook to it | 1973 | ;; Make a local post-command-hook and add our hook to it |
| 1974 | ;; NB: `make-local-hook' needed for older/alternative Emacs compatibility | 1974 | ;; NB: `make-local-hook' needed for older/alternative Emacs compatibility |
| @@ -2000,16 +2000,16 @@ The main features of this mode are | |||
| 2000 | (unless idlwave-setup-done | 2000 | (unless idlwave-setup-done |
| 2001 | (if (not (file-directory-p idlwave-config-directory)) | 2001 | (if (not (file-directory-p idlwave-config-directory)) |
| 2002 | (make-directory idlwave-config-directory)) | 2002 | (make-directory idlwave-config-directory)) |
| 2003 | (setq | 2003 | (setq |
| 2004 | idlwave-user-catalog-file (expand-file-name | 2004 | idlwave-user-catalog-file (expand-file-name |
| 2005 | idlwave-user-catalog-file | 2005 | idlwave-user-catalog-file |
| 2006 | idlwave-config-directory) | 2006 | idlwave-config-directory) |
| 2007 | idlwave-xml-system-rinfo-converted-file | 2007 | idlwave-xml-system-rinfo-converted-file |
| 2008 | (expand-file-name | 2008 | (expand-file-name |
| 2009 | idlwave-xml-system-rinfo-converted-file | 2009 | idlwave-xml-system-rinfo-converted-file |
| 2010 | idlwave-config-directory) | 2010 | idlwave-config-directory) |
| 2011 | idlwave-path-file (expand-file-name | 2011 | idlwave-path-file (expand-file-name |
| 2012 | idlwave-path-file | 2012 | idlwave-path-file |
| 2013 | idlwave-config-directory)) | 2013 | idlwave-config-directory)) |
| 2014 | (idlwave-read-paths) ; we may need these early | 2014 | (idlwave-read-paths) ; we may need these early |
| 2015 | (setq idlwave-setup-done t))) | 2015 | (setq idlwave-setup-done t))) |
| @@ -2028,7 +2028,7 @@ The main features of this mode are | |||
| 2028 | 2028 | ||
| 2029 | ;; | 2029 | ;; |
| 2030 | ;; Code Formatting ---------------------------------------------------- | 2030 | ;; Code Formatting ---------------------------------------------------- |
| 2031 | ;; | 2031 | ;; |
| 2032 | 2032 | ||
| 2033 | (defun idlwave-hard-tab () | 2033 | (defun idlwave-hard-tab () |
| 2034 | "Inserts TAB in buffer in current position." | 2034 | "Inserts TAB in buffer in current position." |
| @@ -2171,7 +2171,7 @@ Also checks if the correct end statement has been used." | |||
| 2171 | (if (> end-pos eol-pos) | 2171 | (if (> end-pos eol-pos) |
| 2172 | (setq end-pos pos)) | 2172 | (setq end-pos pos)) |
| 2173 | (goto-char end-pos) | 2173 | (goto-char end-pos) |
| 2174 | (setq end (buffer-substring | 2174 | (setq end (buffer-substring |
| 2175 | (progn | 2175 | (progn |
| 2176 | (skip-chars-backward "a-zA-Z") | 2176 | (skip-chars-backward "a-zA-Z") |
| 2177 | (point)) | 2177 | (point)) |
| @@ -2193,7 +2193,7 @@ Also checks if the correct end statement has been used." | |||
| 2193 | (sit-for 1)) | 2193 | (sit-for 1)) |
| 2194 | (t | 2194 | (t |
| 2195 | (beep) | 2195 | (beep) |
| 2196 | (message "Warning: Shouldn't this be \"%s\" instead of \"%s\"?" | 2196 | (message "Warning: Shouldn't this be \"%s\" instead of \"%s\"?" |
| 2197 | end1 end) | 2197 | end1 end) |
| 2198 | (sit-for 1)))))))) | 2198 | (sit-for 1)))))))) |
| 2199 | ;;(delete-char 1)) | 2199 | ;;(delete-char 1)) |
| @@ -2205,8 +2205,8 @@ Also checks if the correct end statement has been used." | |||
| 2205 | ((looking-at "pro\\|case\\|switch\\|function\\>") | 2205 | ((looking-at "pro\\|case\\|switch\\|function\\>") |
| 2206 | (assoc (downcase (match-string 0)) idlwave-block-matches)) | 2206 | (assoc (downcase (match-string 0)) idlwave-block-matches)) |
| 2207 | ((looking-at "begin\\>") | 2207 | ((looking-at "begin\\>") |
| 2208 | (let ((limit (save-excursion | 2208 | (let ((limit (save-excursion |
| 2209 | (idlwave-beginning-of-statement) | 2209 | (idlwave-beginning-of-statement) |
| 2210 | (point)))) | 2210 | (point)))) |
| 2211 | (cond | 2211 | (cond |
| 2212 | ((re-search-backward ":[ \t]*\\=" limit t) | 2212 | ((re-search-backward ":[ \t]*\\=" limit t) |
| @@ -2490,7 +2490,7 @@ Returns non-nil if successfull." | |||
| 2490 | (let ((eos (save-excursion | 2490 | (let ((eos (save-excursion |
| 2491 | (idlwave-block-jump-out -1 'nomark) | 2491 | (idlwave-block-jump-out -1 'nomark) |
| 2492 | (point)))) | 2492 | (point)))) |
| 2493 | (if (setq status (idlwave-find-key | 2493 | (if (setq status (idlwave-find-key |
| 2494 | idlwave-end-block-reg -1 'nomark eos)) | 2494 | idlwave-end-block-reg -1 'nomark eos)) |
| 2495 | (idlwave-beginning-of-statement) | 2495 | (idlwave-beginning-of-statement) |
| 2496 | (message "No nested block before beginning of containing block."))) | 2496 | (message "No nested block before beginning of containing block."))) |
| @@ -2498,7 +2498,7 @@ Returns non-nil if successfull." | |||
| 2498 | (let ((eos (save-excursion | 2498 | (let ((eos (save-excursion |
| 2499 | (idlwave-block-jump-out 1 'nomark) | 2499 | (idlwave-block-jump-out 1 'nomark) |
| 2500 | (point)))) | 2500 | (point)))) |
| 2501 | (if (setq status (idlwave-find-key | 2501 | (if (setq status (idlwave-find-key |
| 2502 | idlwave-begin-block-reg 1 'nomark eos)) | 2502 | idlwave-begin-block-reg 1 'nomark eos)) |
| 2503 | (idlwave-end-of-statement) | 2503 | (idlwave-end-of-statement) |
| 2504 | (message "No nested block before end of containing block.")))) | 2504 | (message "No nested block before end of containing block.")))) |
| @@ -2512,7 +2512,7 @@ The marks are pushed." | |||
| 2512 | (here (point))) | 2512 | (here (point))) |
| 2513 | (goto-char (point-max)) | 2513 | (goto-char (point-max)) |
| 2514 | (if (re-search-backward idlwave-doclib-start nil t) | 2514 | (if (re-search-backward idlwave-doclib-start nil t) |
| 2515 | (progn | 2515 | (progn |
| 2516 | (setq beg (progn (beginning-of-line) (point))) | 2516 | (setq beg (progn (beginning-of-line) (point))) |
| 2517 | (if (re-search-forward idlwave-doclib-end nil t) | 2517 | (if (re-search-forward idlwave-doclib-end nil t) |
| 2518 | (progn | 2518 | (progn |
| @@ -2545,7 +2545,7 @@ actual statement." | |||
| 2545 | ((eq major-mode 'idlwave-shell-mode) | 2545 | ((eq major-mode 'idlwave-shell-mode) |
| 2546 | (if (re-search-backward idlwave-shell-prompt-pattern nil t) | 2546 | (if (re-search-backward idlwave-shell-prompt-pattern nil t) |
| 2547 | (goto-char (match-end 0)))) | 2547 | (goto-char (match-end 0)))) |
| 2548 | (t | 2548 | (t |
| 2549 | (if (save-excursion (forward-line -1) (idlwave-is-continuation-line)) | 2549 | (if (save-excursion (forward-line -1) (idlwave-is-continuation-line)) |
| 2550 | (idlwave-previous-statement) | 2550 | (idlwave-previous-statement) |
| 2551 | (beginning-of-line))))) | 2551 | (beginning-of-line))))) |
| @@ -2622,7 +2622,7 @@ If not in a statement just moves to end of line. Returns position." | |||
| 2622 | (let ((save-point (point))) | 2622 | (let ((save-point (point))) |
| 2623 | (when (re-search-forward ".*&" lim t) | 2623 | (when (re-search-forward ".*&" lim t) |
| 2624 | (goto-char (match-end 0)) | 2624 | (goto-char (match-end 0)) |
| 2625 | (if (idlwave-quoted) | 2625 | (if (idlwave-quoted) |
| 2626 | (goto-char save-point) | 2626 | (goto-char save-point) |
| 2627 | (if (eq (char-after (- (point) 2)) ?&) (goto-char save-point)))) | 2627 | (if (eq (char-after (- (point) 2)) ?&) (goto-char save-point)))) |
| 2628 | (point))) | 2628 | (point))) |
| @@ -2639,7 +2639,7 @@ If there is no label point is not moved and nil is returned." | |||
| 2639 | ;; - not in parenthesis (like a[0:3]) | 2639 | ;; - not in parenthesis (like a[0:3]) |
| 2640 | ;; - not followed by another ":" in explicit class, ala a->b::c | 2640 | ;; - not followed by another ":" in explicit class, ala a->b::c |
| 2641 | ;; As many in this mode, this function is heuristic and not an exact | 2641 | ;; As many in this mode, this function is heuristic and not an exact |
| 2642 | ;; parser. | 2642 | ;; parser. |
| 2643 | (let* ((start (point)) | 2643 | (let* ((start (point)) |
| 2644 | (eos (save-excursion (idlwave-end-of-statement) (point))) | 2644 | (eos (save-excursion (idlwave-end-of-statement) (point))) |
| 2645 | (end (idlwave-find-key ":" 1 'nomark eos))) | 2645 | (end (idlwave-find-key ":" 1 'nomark eos))) |
| @@ -2716,7 +2716,7 @@ equal sign will be surrounded by BEFORE and AFTER blanks. If | |||
| 2716 | `idlwave-pad-keyword' is t then keyword assignment is treated just | 2716 | `idlwave-pad-keyword' is t then keyword assignment is treated just |
| 2717 | like assignment statements. When nil, spaces are removed for keyword | 2717 | like assignment statements. When nil, spaces are removed for keyword |
| 2718 | assignment. Any other value keeps the current space around the `='. | 2718 | assignment. Any other value keeps the current space around the `='. |
| 2719 | Limits in for loops are treated as keyword assignment. | 2719 | Limits in for loops are treated as keyword assignment. |
| 2720 | 2720 | ||
| 2721 | Starting with IDL 6.0, a number of op= assignments are available. | 2721 | Starting with IDL 6.0, a number of op= assignments are available. |
| 2722 | Since ambiguities of the form: | 2722 | Since ambiguities of the form: |
| @@ -2733,25 +2733,25 @@ IS-ACTION is ignored. | |||
| 2733 | 2733 | ||
| 2734 | See `idlwave-surround'." | 2734 | See `idlwave-surround'." |
| 2735 | (if idlwave-surround-by-blank | 2735 | (if idlwave-surround-by-blank |
| 2736 | (let | 2736 | (let |
| 2737 | ((non-an-ops "\\(##\\|\\*\\|\\+\\|-\\|/\\|<\\|>\\|\\^\\)\\=") | 2737 | ((non-an-ops "\\(##\\|\\*\\|\\+\\|-\\|/\\|<\\|>\\|\\^\\)\\=") |
| 2738 | (an-ops | 2738 | (an-ops |
| 2739 | "\\s-\\(AND\\|EQ\\|GE\\|GT\\|LE\\|LT\\|MOD\\|NE\\|OR\\|XOR\\)\\=") | 2739 | "\\s-\\(AND\\|EQ\\|GE\\|GT\\|LE\\|LT\\|MOD\\|NE\\|OR\\|XOR\\)\\=") |
| 2740 | (len 1)) | 2740 | (len 1)) |
| 2741 | 2741 | ||
| 2742 | (save-excursion | 2742 | (save-excursion |
| 2743 | (let ((case-fold-search t)) | 2743 | (let ((case-fold-search t)) |
| 2744 | (backward-char) | 2744 | (backward-char) |
| 2745 | (if (or | 2745 | (if (or |
| 2746 | (re-search-backward non-an-ops nil t) | 2746 | (re-search-backward non-an-ops nil t) |
| 2747 | ;; Why doesn't ##? work for both? | 2747 | ;; Why doesn't ##? work for both? |
| 2748 | (re-search-backward "\\(#\\)\\=" nil t)) | 2748 | (re-search-backward "\\(#\\)\\=" nil t)) |
| 2749 | (setq len (1+ (length (match-string 1)))) | 2749 | (setq len (1+ (length (match-string 1)))) |
| 2750 | (when (re-search-backward an-ops nil t) | 2750 | (when (re-search-backward an-ops nil t) |
| 2751 | ;(setq begin nil) ; won't modify begin | 2751 | ;(setq begin nil) ; won't modify begin |
| 2752 | (setq len (1+ (length (match-string 1)))))))) | 2752 | (setq len (1+ (length (match-string 1)))))))) |
| 2753 | 2753 | ||
| 2754 | (if (eq t idlwave-pad-keyword) | 2754 | (if (eq t idlwave-pad-keyword) |
| 2755 | ;; Everything gets padded equally | 2755 | ;; Everything gets padded equally |
| 2756 | (idlwave-surround before after len) | 2756 | (idlwave-surround before after len) |
| 2757 | ;; Treating keywords/for variables specially... | 2757 | ;; Treating keywords/for variables specially... |
| @@ -2762,22 +2762,22 @@ See `idlwave-surround'." | |||
| 2762 | (skip-chars-backward "= \t") | 2762 | (skip-chars-backward "= \t") |
| 2763 | (nth 2 (idlwave-where))))) | 2763 | (nth 2 (idlwave-where))))) |
| 2764 | (cond ((or (memq what '(function-keyword procedure-keyword)) | 2764 | (cond ((or (memq what '(function-keyword procedure-keyword)) |
| 2765 | (memq (caar st) '(for pdef))) | 2765 | (memq (caar st) '(for pdef))) |
| 2766 | (cond | 2766 | (cond |
| 2767 | ((null idlwave-pad-keyword) | 2767 | ((null idlwave-pad-keyword) |
| 2768 | (idlwave-surround 0 0) | 2768 | (idlwave-surround 0 0) |
| 2769 | ) ; remove space | 2769 | ) ; remove space |
| 2770 | (t))) ; leave any spaces alone | 2770 | (t))) ; leave any spaces alone |
| 2771 | (t (idlwave-surround before after len)))))))) | 2771 | (t (idlwave-surround before after len)))))))) |
| 2772 | 2772 | ||
| 2773 | 2773 | ||
| 2774 | (defun idlwave-indent-and-action (&optional arg) | 2774 | (defun idlwave-indent-and-action (&optional arg) |
| 2775 | "Call `idlwave-indent-line' and do expand actions. | 2775 | "Call `idlwave-indent-line' and do expand actions. |
| 2776 | With prefix ARG non-nil, indent the entire sub-statement." | 2776 | With prefix ARG non-nil, indent the entire sub-statement." |
| 2777 | (interactive "p") | 2777 | (interactive "p") |
| 2778 | (save-excursion | 2778 | (save-excursion |
| 2779 | (if (and idlwave-expand-generic-end | 2779 | (if (and idlwave-expand-generic-end |
| 2780 | (re-search-backward "\\<\\(end\\)\\s-*\\=" | 2780 | (re-search-backward "\\<\\(end\\)\\s-*\\=" |
| 2781 | (max 0 (- (point) 10)) t) | 2781 | (max 0 (- (point) 10)) t) |
| 2782 | (looking-at "\\(end\\)\\([ \n\t]\\|\\'\\)")) | 2782 | (looking-at "\\(end\\)\\([ \n\t]\\|\\'\\)")) |
| 2783 | (progn (goto-char (match-end 1)) | 2783 | (progn (goto-char (match-end 1)) |
| @@ -2787,7 +2787,7 @@ With prefix ARG non-nil, indent the entire sub-statement." | |||
| 2787 | (when (and (not arg) current-prefix-arg) | 2787 | (when (and (not arg) current-prefix-arg) |
| 2788 | (setq arg current-prefix-arg) | 2788 | (setq arg current-prefix-arg) |
| 2789 | (setq current-prefix-arg nil)) | 2789 | (setq current-prefix-arg nil)) |
| 2790 | (if arg | 2790 | (if arg |
| 2791 | (idlwave-indent-statement) | 2791 | (idlwave-indent-statement) |
| 2792 | (idlwave-indent-line t))) | 2792 | (idlwave-indent-line t))) |
| 2793 | 2793 | ||
| @@ -2922,7 +2922,7 @@ Inserts spaces before markers at point." | |||
| 2922 | (save-excursion | 2922 | (save-excursion |
| 2923 | (cond | 2923 | (cond |
| 2924 | ;; Beginning of file | 2924 | ;; Beginning of file |
| 2925 | ((prog1 | 2925 | ((prog1 |
| 2926 | (idlwave-previous-statement) | 2926 | (idlwave-previous-statement) |
| 2927 | (setq beg-prev-pos (point))) | 2927 | (setq beg-prev-pos (point))) |
| 2928 | 0) | 2928 | 0) |
| @@ -2932,7 +2932,7 @@ Inserts spaces before markers at point." | |||
| 2932 | idlwave-main-block-indent)) | 2932 | idlwave-main-block-indent)) |
| 2933 | ;; Begin block | 2933 | ;; Begin block |
| 2934 | ((idlwave-look-at idlwave-begin-block-reg t) | 2934 | ((idlwave-look-at idlwave-begin-block-reg t) |
| 2935 | (+ (idlwave-min-current-statement-indent) | 2935 | (+ (idlwave-min-current-statement-indent) |
| 2936 | idlwave-block-indent)) | 2936 | idlwave-block-indent)) |
| 2937 | ;; End Block | 2937 | ;; End Block |
| 2938 | ((idlwave-look-at idlwave-end-block-reg t) | 2938 | ((idlwave-look-at idlwave-end-block-reg t) |
| @@ -2943,7 +2943,7 @@ Inserts spaces before markers at point." | |||
| 2943 | (idlwave-min-current-statement-indent))) | 2943 | (idlwave-min-current-statement-indent))) |
| 2944 | ;; idlwave-end-offset | 2944 | ;; idlwave-end-offset |
| 2945 | ;; idlwave-block-indent)) | 2945 | ;; idlwave-block-indent)) |
| 2946 | 2946 | ||
| 2947 | ;; Default to current indent | 2947 | ;; Default to current indent |
| 2948 | ((idlwave-current-statement-indent)))))) | 2948 | ((idlwave-current-statement-indent)))))) |
| 2949 | ;; adjust the indentation based on the current statement | 2949 | ;; adjust the indentation based on the current statement |
| @@ -2959,7 +2959,7 @@ Inserts spaces before markers at point." | |||
| 2959 | 2959 | ||
| 2960 | (defun idlwave-calculate-paren-indent (beg-reg end-reg close-exp) | 2960 | (defun idlwave-calculate-paren-indent (beg-reg end-reg close-exp) |
| 2961 | "Calculate the continuation indent inside a paren group. | 2961 | "Calculate the continuation indent inside a paren group. |
| 2962 | Returns a cons-cell with (open . indent), where open is the | 2962 | Returns a cons-cell with (open . indent), where open is the |
| 2963 | location of the open paren" | 2963 | location of the open paren" |
| 2964 | (let ((open (nth 1 (parse-partial-sexp beg-reg end-reg)))) | 2964 | (let ((open (nth 1 (parse-partial-sexp beg-reg end-reg)))) |
| 2965 | ;; Found an innermost open paren. | 2965 | ;; Found an innermost open paren. |
| @@ -3000,24 +3000,24 @@ groupings, are treated separately." | |||
| 3000 | (end-reg (progn (beginning-of-line) (point))) | 3000 | (end-reg (progn (beginning-of-line) (point))) |
| 3001 | (beg-last-statement (save-excursion (idlwave-previous-statement) | 3001 | (beg-last-statement (save-excursion (idlwave-previous-statement) |
| 3002 | (point))) | 3002 | (point))) |
| 3003 | (beg-reg (progn (idlwave-start-of-substatement 'pre) | 3003 | (beg-reg (progn (idlwave-start-of-substatement 'pre) |
| 3004 | (if (eq (line-beginning-position) end-reg) | 3004 | (if (eq (line-beginning-position) end-reg) |
| 3005 | (goto-char beg-last-statement) | 3005 | (goto-char beg-last-statement) |
| 3006 | (point)))) | 3006 | (point)))) |
| 3007 | (basic-indent (+ (idlwave-min-current-statement-indent end-reg) | 3007 | (basic-indent (+ (idlwave-min-current-statement-indent end-reg) |
| 3008 | idlwave-continuation-indent)) | 3008 | idlwave-continuation-indent)) |
| 3009 | fancy-nonparen-indent fancy-paren-indent) | 3009 | fancy-nonparen-indent fancy-paren-indent) |
| 3010 | (cond | 3010 | (cond |
| 3011 | ;; Align then with its matching if, etc. | 3011 | ;; Align then with its matching if, etc. |
| 3012 | ((let ((matchers '(("\\<if\\>" . "[ \t]*then") | 3012 | ((let ((matchers '(("\\<if\\>" . "[ \t]*then") |
| 3013 | ("\\<\\(if\\|end\\(if\\)?\\)\\>" . "[ \t]*else") | 3013 | ("\\<\\(if\\|end\\(if\\)?\\)\\>" . "[ \t]*else") |
| 3014 | ("\\<\\(for\\|while\\)\\>" . "[ \t]*do") | 3014 | ("\\<\\(for\\|while\\)\\>" . "[ \t]*do") |
| 3015 | ("\\<\\(repeat\\|end\\(rep\\)?\\)\\>" . | 3015 | ("\\<\\(repeat\\|end\\(rep\\)?\\)\\>" . |
| 3016 | "[ \t]*until") | 3016 | "[ \t]*until") |
| 3017 | ("\\<case\\>" . "[ \t]*of"))) | 3017 | ("\\<case\\>" . "[ \t]*of"))) |
| 3018 | match cont-re) | 3018 | match cont-re) |
| 3019 | (goto-char end-reg) | 3019 | (goto-char end-reg) |
| 3020 | (and | 3020 | (and |
| 3021 | (setq cont-re | 3021 | (setq cont-re |
| 3022 | (catch 'exit | 3022 | (catch 'exit |
| 3023 | (while (setq match (car matchers)) | 3023 | (while (setq match (car matchers)) |
| @@ -3026,7 +3026,7 @@ groupings, are treated separately." | |||
| 3026 | (setq matchers (cdr matchers))))) | 3026 | (setq matchers (cdr matchers))))) |
| 3027 | (idlwave-find-key cont-re -1 'nomark beg-last-statement))) | 3027 | (idlwave-find-key cont-re -1 'nomark beg-last-statement))) |
| 3028 | (if (looking-at "end") ;; that one's special | 3028 | (if (looking-at "end") ;; that one's special |
| 3029 | (- (idlwave-current-indent) | 3029 | (- (idlwave-current-indent) |
| 3030 | (+ idlwave-block-indent idlwave-end-offset)) | 3030 | (+ idlwave-block-indent idlwave-end-offset)) |
| 3031 | (idlwave-current-indent))) | 3031 | (idlwave-current-indent))) |
| 3032 | 3032 | ||
| @@ -3052,7 +3052,7 @@ groupings, are treated separately." | |||
| 3052 | (let* ((end-reg end-reg) | 3052 | (let* ((end-reg end-reg) |
| 3053 | (close-exp (progn | 3053 | (close-exp (progn |
| 3054 | (goto-char end-reg) | 3054 | (goto-char end-reg) |
| 3055 | (skip-chars-forward " \t") | 3055 | (skip-chars-forward " \t") |
| 3056 | (looking-at "\\s)"))) | 3056 | (looking-at "\\s)"))) |
| 3057 | indent-cons) | 3057 | indent-cons) |
| 3058 | (catch 'loop | 3058 | (catch 'loop |
| @@ -3086,12 +3086,12 @@ groupings, are treated separately." | |||
| 3086 | (if (save-match-data (looking-at "[ \t$]*\\(;.*\\)?$")) | 3086 | (if (save-match-data (looking-at "[ \t$]*\\(;.*\\)?$")) |
| 3087 | nil | 3087 | nil |
| 3088 | (current-column))) | 3088 | (current-column))) |
| 3089 | 3089 | ||
| 3090 | ;; Continued assignment (with =): | 3090 | ;; Continued assignment (with =): |
| 3091 | ((catch 'assign ; | 3091 | ((catch 'assign ; |
| 3092 | (while (looking-at "[^=\n\r]*\\(=\\)[ \t]*") | 3092 | (while (looking-at "[^=\n\r]*\\(=\\)[ \t]*") |
| 3093 | (goto-char (match-end 0)) | 3093 | (goto-char (match-end 0)) |
| 3094 | (if (null (idlwave-what-function beg-reg)) | 3094 | (if (null (idlwave-what-function beg-reg)) |
| 3095 | (throw 'assign t)))) | 3095 | (throw 'assign t)))) |
| 3096 | (unless (or | 3096 | (unless (or |
| 3097 | (idlwave-in-quote) | 3097 | (idlwave-in-quote) |
| @@ -3153,7 +3153,7 @@ possibility of unbalanced blocks." | |||
| 3153 | (let* ((here (point)) | 3153 | (let* ((here (point)) |
| 3154 | (case-fold-search t) | 3154 | (case-fold-search t) |
| 3155 | (limit (if (>= dir 0) (point-max) (point-min))) | 3155 | (limit (if (>= dir 0) (point-max) (point-min))) |
| 3156 | (block-limit (if (>= dir 0) | 3156 | (block-limit (if (>= dir 0) |
| 3157 | idlwave-begin-block-reg | 3157 | idlwave-begin-block-reg |
| 3158 | idlwave-end-block-reg)) | 3158 | idlwave-end-block-reg)) |
| 3159 | found | 3159 | found |
| @@ -3164,7 +3164,7 @@ possibility of unbalanced blocks." | |||
| 3164 | (idlwave-find-key | 3164 | (idlwave-find-key |
| 3165 | idlwave-begin-unit-reg dir t limit) | 3165 | idlwave-begin-unit-reg dir t limit) |
| 3166 | (end-of-line) | 3166 | (end-of-line) |
| 3167 | (idlwave-find-key | 3167 | (idlwave-find-key |
| 3168 | idlwave-end-unit-reg dir t limit))) | 3168 | idlwave-end-unit-reg dir t limit))) |
| 3169 | limit))) | 3169 | limit))) |
| 3170 | (if (>= dir 0) (end-of-line)) ;Make sure we are in current block | 3170 | (if (>= dir 0) (end-of-line)) ;Make sure we are in current block |
| @@ -3189,7 +3189,7 @@ possibility of unbalanced blocks." | |||
| 3189 | (or (null end-reg) (< (point) end-reg))) | 3189 | (or (null end-reg) (< (point) end-reg))) |
| 3190 | (unless comm-or-empty (setq min (min min (idlwave-current-indent))))) | 3190 | (unless comm-or-empty (setq min (min min (idlwave-current-indent))))) |
| 3191 | (if (or comm-or-empty (and end-reg (>= (point) end-reg))) | 3191 | (if (or comm-or-empty (and end-reg (>= (point) end-reg))) |
| 3192 | min | 3192 | min |
| 3193 | (min min (idlwave-current-indent)))))) | 3193 | (min min (idlwave-current-indent)))))) |
| 3194 | 3194 | ||
| 3195 | (defun idlwave-current-statement-indent (&optional last-line) | 3195 | (defun idlwave-current-statement-indent (&optional last-line) |
| @@ -3216,10 +3216,10 @@ Blank or comment-only lines following regular continuation lines (with | |||
| 3216 | `$') count as continuations too." | 3216 | `$') count as continuations too." |
| 3217 | (let (p) | 3217 | (let (p) |
| 3218 | (save-excursion | 3218 | (save-excursion |
| 3219 | (or | 3219 | (or |
| 3220 | (idlwave-look-at "\\<\\$") | 3220 | (idlwave-look-at "\\<\\$") |
| 3221 | (catch 'loop | 3221 | (catch 'loop |
| 3222 | (while (and (looking-at "^[ \t]*\\(;.*\\)?$") | 3222 | (while (and (looking-at "^[ \t]*\\(;.*\\)?$") |
| 3223 | (eq (forward-line -1) 0)) | 3223 | (eq (forward-line -1) 0)) |
| 3224 | (if (setq p (idlwave-look-at "\\<\\$")) (throw 'loop p)))))))) | 3224 | (if (setq p (idlwave-look-at "\\<\\$")) (throw 'loop p)))))))) |
| 3225 | 3225 | ||
| @@ -3317,7 +3317,7 @@ ignored." | |||
| 3317 | (beginning-of-line) (point)) | 3317 | (beginning-of-line) (point)) |
| 3318 | (point)))) | 3318 | (point)))) |
| 3319 | "[^;]")) | 3319 | "[^;]")) |
| 3320 | 3320 | ||
| 3321 | ;; Mark the beginning and end of the paragraph | 3321 | ;; Mark the beginning and end of the paragraph |
| 3322 | (goto-char bcl) | 3322 | (goto-char bcl) |
| 3323 | (while (and (looking-at fill-prefix-reg) | 3323 | (while (and (looking-at fill-prefix-reg) |
| @@ -3381,7 +3381,7 @@ ignored." | |||
| 3381 | (insert (make-string diff ?\ )))) | 3381 | (insert (make-string diff ?\ )))) |
| 3382 | (forward-line -1)) | 3382 | (forward-line -1)) |
| 3383 | ) | 3383 | ) |
| 3384 | 3384 | ||
| 3385 | ;; No hang. Instead find minimum indentation of paragraph | 3385 | ;; No hang. Instead find minimum indentation of paragraph |
| 3386 | ;; after first line. | 3386 | ;; after first line. |
| 3387 | ;; For the following while statement, since START is at the | 3387 | ;; For the following while statement, since START is at the |
| @@ -3413,7 +3413,7 @@ ignored." | |||
| 3413 | t) | 3413 | t) |
| 3414 | (current-column)) | 3414 | (current-column)) |
| 3415 | indent)) | 3415 | indent)) |
| 3416 | 3416 | ||
| 3417 | ;; try to keep point at its original place | 3417 | ;; try to keep point at its original place |
| 3418 | (goto-char here) | 3418 | (goto-char here) |
| 3419 | 3419 | ||
| @@ -3462,7 +3462,7 @@ If not found returns nil." | |||
| 3462 | (current-column))))) | 3462 | (current-column))))) |
| 3463 | 3463 | ||
| 3464 | (defun idlwave-auto-fill () | 3464 | (defun idlwave-auto-fill () |
| 3465 | "Called to break lines in auto fill mode. | 3465 | "Called to break lines in auto fill mode. |
| 3466 | Only fills non-comment lines if `idlwave-fill-comment-line-only' is | 3466 | Only fills non-comment lines if `idlwave-fill-comment-line-only' is |
| 3467 | non-nil. Places a continuation character at the end of the line if | 3467 | non-nil. Places a continuation character at the end of the line if |
| 3468 | not in a comment. Splits strings with IDL concatenation operator `+' | 3468 | not in a comment. Splits strings with IDL concatenation operator `+' |
| @@ -3613,7 +3613,7 @@ is non-nil." | |||
| 3613 | (insert (current-time-string)) | 3613 | (insert (current-time-string)) |
| 3614 | (insert ", " (user-full-name)) | 3614 | (insert ", " (user-full-name)) |
| 3615 | (if (boundp 'user-mail-address) | 3615 | (if (boundp 'user-mail-address) |
| 3616 | (insert " <" user-mail-address ">") | 3616 | (insert " <" user-mail-address ">") |
| 3617 | (insert " <" (user-login-name) "@" (system-name) ">")) | 3617 | (insert " <" (user-login-name) "@" (system-name) ">")) |
| 3618 | ;; Remove extra spaces from line | 3618 | ;; Remove extra spaces from line |
| 3619 | (idlwave-fill-paragraph) | 3619 | (idlwave-fill-paragraph) |
| @@ -3639,7 +3639,7 @@ location on mark ring so that the user can return to previous point." | |||
| 3639 | (setq end (match-end 0))) | 3639 | (setq end (match-end 0))) |
| 3640 | (progn | 3640 | (progn |
| 3641 | (goto-char beg) | 3641 | (goto-char beg) |
| 3642 | (if (re-search-forward | 3642 | (if (re-search-forward |
| 3643 | (concat idlwave-doc-modifications-keyword ":") | 3643 | (concat idlwave-doc-modifications-keyword ":") |
| 3644 | end t) | 3644 | end t) |
| 3645 | (end-of-line) | 3645 | (end-of-line) |
| @@ -3737,7 +3737,7 @@ constants - a double quote followed by an octal digit." | |||
| 3737 | (not (idlwave-in-quote)) | 3737 | (not (idlwave-in-quote)) |
| 3738 | (save-excursion | 3738 | (save-excursion |
| 3739 | (forward-char) | 3739 | (forward-char) |
| 3740 | (re-search-backward (concat "\\(" idlwave-idl-keywords | 3740 | (re-search-backward (concat "\\(" idlwave-idl-keywords |
| 3741 | "\\|[[(*+-/=,^><]\\)\\s-*\\*") limit t))))) | 3741 | "\\|[[(*+-/=,^><]\\)\\s-*\\*") limit t))))) |
| 3742 | 3742 | ||
| 3743 | 3743 | ||
| @@ -3783,7 +3783,7 @@ unless the optional second argument NOINDENT is non-nil." | |||
| 3783 | (indent-region beg end nil)) | 3783 | (indent-region beg end nil)) |
| 3784 | (if (stringp prompt) | 3784 | (if (stringp prompt) |
| 3785 | (message prompt))))) | 3785 | (message prompt))))) |
| 3786 | 3786 | ||
| 3787 | (defun idlwave-rw-case (string) | 3787 | (defun idlwave-rw-case (string) |
| 3788 | "Make STRING have the case required by `idlwave-reserved-word-upcase'." | 3788 | "Make STRING have the case required by `idlwave-reserved-word-upcase'." |
| 3789 | (if idlwave-reserved-word-upcase | 3789 | (if idlwave-reserved-word-upcase |
| @@ -3801,7 +3801,7 @@ unless the optional second argument NOINDENT is non-nil." | |||
| 3801 | (defun idlwave-case () | 3801 | (defun idlwave-case () |
| 3802 | "Build skeleton IDL case statement." | 3802 | "Build skeleton IDL case statement." |
| 3803 | (interactive) | 3803 | (interactive) |
| 3804 | (idlwave-template | 3804 | (idlwave-template |
| 3805 | (idlwave-rw-case "case") | 3805 | (idlwave-rw-case "case") |
| 3806 | (idlwave-rw-case " of\n\nendcase") | 3806 | (idlwave-rw-case " of\n\nendcase") |
| 3807 | "Selector expression")) | 3807 | "Selector expression")) |
| @@ -3809,7 +3809,7 @@ unless the optional second argument NOINDENT is non-nil." | |||
| 3809 | (defun idlwave-switch () | 3809 | (defun idlwave-switch () |
| 3810 | "Build skeleton IDL switch statement." | 3810 | "Build skeleton IDL switch statement." |
| 3811 | (interactive) | 3811 | (interactive) |
| 3812 | (idlwave-template | 3812 | (idlwave-template |
| 3813 | (idlwave-rw-case "switch") | 3813 | (idlwave-rw-case "switch") |
| 3814 | (idlwave-rw-case " of\n\nendswitch") | 3814 | (idlwave-rw-case " of\n\nendswitch") |
| 3815 | "Selector expression")) | 3815 | "Selector expression")) |
| @@ -3817,7 +3817,7 @@ unless the optional second argument NOINDENT is non-nil." | |||
| 3817 | (defun idlwave-for () | 3817 | (defun idlwave-for () |
| 3818 | "Build skeleton for loop statment." | 3818 | "Build skeleton for loop statment." |
| 3819 | (interactive) | 3819 | (interactive) |
| 3820 | (idlwave-template | 3820 | (idlwave-template |
| 3821 | (idlwave-rw-case "for") | 3821 | (idlwave-rw-case "for") |
| 3822 | (idlwave-rw-case " do begin\n\nendfor") | 3822 | (idlwave-rw-case " do begin\n\nendfor") |
| 3823 | "Loop expression")) | 3823 | "Loop expression")) |
| @@ -3832,14 +3832,14 @@ unless the optional second argument NOINDENT is non-nil." | |||
| 3832 | 3832 | ||
| 3833 | (defun idlwave-procedure () | 3833 | (defun idlwave-procedure () |
| 3834 | (interactive) | 3834 | (interactive) |
| 3835 | (idlwave-template | 3835 | (idlwave-template |
| 3836 | (idlwave-rw-case "pro") | 3836 | (idlwave-rw-case "pro") |
| 3837 | (idlwave-rw-case "\n\nreturn\nend") | 3837 | (idlwave-rw-case "\n\nreturn\nend") |
| 3838 | "Procedure name")) | 3838 | "Procedure name")) |
| 3839 | 3839 | ||
| 3840 | (defun idlwave-function () | 3840 | (defun idlwave-function () |
| 3841 | (interactive) | 3841 | (interactive) |
| 3842 | (idlwave-template | 3842 | (idlwave-template |
| 3843 | (idlwave-rw-case "function") | 3843 | (idlwave-rw-case "function") |
| 3844 | (idlwave-rw-case "\n\nreturn\nend") | 3844 | (idlwave-rw-case "\n\nreturn\nend") |
| 3845 | "Function name")) | 3845 | "Function name")) |
| @@ -3853,7 +3853,7 @@ unless the optional second argument NOINDENT is non-nil." | |||
| 3853 | 3853 | ||
| 3854 | (defun idlwave-while () | 3854 | (defun idlwave-while () |
| 3855 | (interactive) | 3855 | (interactive) |
| 3856 | (idlwave-template | 3856 | (idlwave-template |
| 3857 | (idlwave-rw-case "while") | 3857 | (idlwave-rw-case "while") |
| 3858 | (idlwave-rw-case " do begin\n\nendwhile") | 3858 | (idlwave-rw-case " do begin\n\nendwhile") |
| 3859 | "Entry condition")) | 3859 | "Entry condition")) |
| @@ -3932,8 +3932,8 @@ Buffer containing unsaved changes require confirmation before they are killed." | |||
| 3932 | (defun idlwave-count-outlawed-buffers (tag) | 3932 | (defun idlwave-count-outlawed-buffers (tag) |
| 3933 | "How many outlawed buffers have tag TAG?" | 3933 | "How many outlawed buffers have tag TAG?" |
| 3934 | (length (delq nil | 3934 | (length (delq nil |
| 3935 | (mapcar | 3935 | (mapcar |
| 3936 | (lambda (x) (eq (cdr x) tag)) | 3936 | (lambda (x) (eq (cdr x) tag)) |
| 3937 | idlwave-outlawed-buffers)))) | 3937 | idlwave-outlawed-buffers)))) |
| 3938 | 3938 | ||
| 3939 | (defun idlwave-do-kill-autoloaded-buffers (&rest reasons) | 3939 | (defun idlwave-do-kill-autoloaded-buffers (&rest reasons) |
| @@ -3947,9 +3947,9 @@ Buffer containing unsaved changes require confirmation before they are killed." | |||
| 3947 | (memq (cdr entry) reasons)) | 3947 | (memq (cdr entry) reasons)) |
| 3948 | (kill-buffer (car entry)) | 3948 | (kill-buffer (car entry)) |
| 3949 | (incf cnt) | 3949 | (incf cnt) |
| 3950 | (setq idlwave-outlawed-buffers | 3950 | (setq idlwave-outlawed-buffers |
| 3951 | (delq entry idlwave-outlawed-buffers))) | 3951 | (delq entry idlwave-outlawed-buffers))) |
| 3952 | (setq idlwave-outlawed-buffers | 3952 | (setq idlwave-outlawed-buffers |
| 3953 | (delq entry idlwave-outlawed-buffers)))) | 3953 | (delq entry idlwave-outlawed-buffers)))) |
| 3954 | (message "%d buffer%s killed" cnt (if (= cnt 1) "" "s")))) | 3954 | (message "%d buffer%s killed" cnt (if (= cnt 1) "" "s")))) |
| 3955 | 3955 | ||
| @@ -3961,7 +3961,7 @@ Intended for `after-save-hook'." | |||
| 3961 | (entry (assq buf idlwave-outlawed-buffers))) | 3961 | (entry (assq buf idlwave-outlawed-buffers))) |
| 3962 | ;; Revoke license | 3962 | ;; Revoke license |
| 3963 | (if entry | 3963 | (if entry |
| 3964 | (setq idlwave-outlawed-buffers | 3964 | (setq idlwave-outlawed-buffers |
| 3965 | (delq entry idlwave-outlawed-buffers))) | 3965 | (delq entry idlwave-outlawed-buffers))) |
| 3966 | ;; Remove this function from the hook. | 3966 | ;; Remove this function from the hook. |
| 3967 | (remove-hook 'after-save-hook 'idlwave-revoke-license-to-kill 'local))) | 3967 | (remove-hook 'after-save-hook 'idlwave-revoke-license-to-kill 'local))) |
| @@ -3980,7 +3980,7 @@ Intended for `after-save-hook'." | |||
| 3980 | (defun idlwave-expand-lib-file-name (file) | 3980 | (defun idlwave-expand-lib-file-name (file) |
| 3981 | ;; Find FILE on the scanned lib path and return a buffer visiting it | 3981 | ;; Find FILE on the scanned lib path and return a buffer visiting it |
| 3982 | ;; This is for, e.g., finding source with no user catalog | 3982 | ;; This is for, e.g., finding source with no user catalog |
| 3983 | (cond | 3983 | (cond |
| 3984 | ((null file) nil) | 3984 | ((null file) nil) |
| 3985 | ((file-name-absolute-p file) file) | 3985 | ((file-name-absolute-p file) file) |
| 3986 | (t (idlwave-locate-lib-file file)))) | 3986 | (t (idlwave-locate-lib-file file)))) |
| @@ -3995,7 +3995,7 @@ you specify /." | |||
| 3995 | (interactive) | 3995 | (interactive) |
| 3996 | (let (directory directories cmd append status numdirs dir getsubdirs | 3996 | (let (directory directories cmd append status numdirs dir getsubdirs |
| 3997 | buffer save_buffer files numfiles item errbuf) | 3997 | buffer save_buffer files numfiles item errbuf) |
| 3998 | 3998 | ||
| 3999 | ;; | 3999 | ;; |
| 4000 | ;; Read list of directories | 4000 | ;; Read list of directories |
| 4001 | (setq directory (read-string "Tag Directories: " ".")) | 4001 | (setq directory (read-string "Tag Directories: " ".")) |
| @@ -4047,7 +4047,7 @@ you specify /." | |||
| 4047 | (message "%s" (concat "Tagging " item "...")) | 4047 | (message "%s" (concat "Tagging " item "...")) |
| 4048 | (setq errbuf (get-buffer-create "*idltags-error*")) | 4048 | (setq errbuf (get-buffer-create "*idltags-error*")) |
| 4049 | (setq status (+ status | 4049 | (setq status (+ status |
| 4050 | (if (eq 0 (call-process | 4050 | (if (eq 0 (call-process |
| 4051 | "sh" nil errbuf nil "-c" | 4051 | "sh" nil errbuf nil "-c" |
| 4052 | (concat cmd append item))) | 4052 | (concat cmd append item))) |
| 4053 | 0 | 4053 | 0 |
| @@ -4061,13 +4061,13 @@ you specify /." | |||
| 4061 | (setq numfiles (1+ numfiles)) | 4061 | (setq numfiles (1+ numfiles)) |
| 4062 | (setq item (nth numfiles files)) | 4062 | (setq item (nth numfiles files)) |
| 4063 | ))) | 4063 | ))) |
| 4064 | 4064 | ||
| 4065 | (setq numdirs (1+ numdirs)) | 4065 | (setq numdirs (1+ numdirs)) |
| 4066 | (setq dir (nth numdirs directories))) | 4066 | (setq dir (nth numdirs directories))) |
| 4067 | (progn | 4067 | (progn |
| 4068 | (setq numdirs (1+ numdirs)) | 4068 | (setq numdirs (1+ numdirs)) |
| 4069 | (setq dir (nth numdirs directories))))) | 4069 | (setq dir (nth numdirs directories))))) |
| 4070 | 4070 | ||
| 4071 | (setq errbuf (get-buffer-create "*idltags-error*")) | 4071 | (setq errbuf (get-buffer-create "*idltags-error*")) |
| 4072 | (if (= status 0) | 4072 | (if (= status 0) |
| 4073 | (kill-buffer errbuf)) | 4073 | (kill-buffer errbuf)) |
| @@ -4143,7 +4143,7 @@ blank lines." | |||
| 4143 | ;; Make sure the hash functions are accessible. | 4143 | ;; Make sure the hash functions are accessible. |
| 4144 | (if (or (not (fboundp 'gethash)) | 4144 | (if (or (not (fboundp 'gethash)) |
| 4145 | (not (fboundp 'puthash))) | 4145 | (not (fboundp 'puthash))) |
| 4146 | (progn | 4146 | (progn |
| 4147 | (require 'cl) | 4147 | (require 'cl) |
| 4148 | (or (fboundp 'puthash) | 4148 | (or (fboundp 'puthash) |
| 4149 | (defalias 'puthash 'cl-puthash)))) | 4149 | (defalias 'puthash 'cl-puthash)))) |
| @@ -4162,7 +4162,7 @@ blank lines." | |||
| 4162 | (null (cdr idlwave-sint-routines))) | 4162 | (null (cdr idlwave-sint-routines))) |
| 4163 | (loop for entry in entries | 4163 | (loop for entry in entries |
| 4164 | for var = (car entry) for size = (nth 1 entry) | 4164 | for var = (car entry) for size = (nth 1 entry) |
| 4165 | do (setcdr (symbol-value var) | 4165 | do (setcdr (symbol-value var) |
| 4166 | (make-hash-table ':size size ':test 'equal))) | 4166 | (make-hash-table ':size size ':test 'equal))) |
| 4167 | (setq idlwave-sint-dirs nil | 4167 | (setq idlwave-sint-dirs nil |
| 4168 | idlwave-sint-libnames nil)) | 4168 | idlwave-sint-libnames nil)) |
| @@ -4172,7 +4172,7 @@ blank lines." | |||
| 4172 | (null (car idlwave-sint-routines))) | 4172 | (null (car idlwave-sint-routines))) |
| 4173 | (loop for entry in entries | 4173 | (loop for entry in entries |
| 4174 | for var = (car entry) for size = (nth 1 entry) | 4174 | for var = (car entry) for size = (nth 1 entry) |
| 4175 | do (setcar (symbol-value var) | 4175 | do (setcar (symbol-value var) |
| 4176 | (make-hash-table ':size size ':test 'equal)))))) | 4176 | (make-hash-table ':size size ':test 'equal)))))) |
| 4177 | 4177 | ||
| 4178 | (defun idlwave-sintern-routine-or-method (name &optional class set) | 4178 | (defun idlwave-sintern-routine-or-method (name &optional class set) |
| @@ -4259,11 +4259,11 @@ If DEFAULT-DIR is passed, it is used as the base of the directory" | |||
| 4259 | (setq class (idlwave-sintern-class class set)) | 4259 | (setq class (idlwave-sintern-class class set)) |
| 4260 | (setq name (idlwave-sintern-method name set))) | 4260 | (setq name (idlwave-sintern-method name set))) |
| 4261 | (setq name (idlwave-sintern-routine name set))) | 4261 | (setq name (idlwave-sintern-routine name set))) |
| 4262 | 4262 | ||
| 4263 | ;; The source | 4263 | ;; The source |
| 4264 | (let ((source-type (car source)) | 4264 | (let ((source-type (car source)) |
| 4265 | (source-file (nth 1 source)) | 4265 | (source-file (nth 1 source)) |
| 4266 | (source-dir (if default-dir | 4266 | (source-dir (if default-dir |
| 4267 | (file-name-as-directory default-dir) | 4267 | (file-name-as-directory default-dir) |
| 4268 | (nth 2 source))) | 4268 | (nth 2 source))) |
| 4269 | (source-lib (nth 3 source))) | 4269 | (source-lib (nth 3 source))) |
| @@ -4272,7 +4272,7 @@ If DEFAULT-DIR is passed, it is used as the base of the directory" | |||
| 4272 | (if (stringp source-lib) | 4272 | (if (stringp source-lib) |
| 4273 | (setq source-lib (idlwave-sintern-libname source-lib set))) | 4273 | (setq source-lib (idlwave-sintern-libname source-lib set))) |
| 4274 | (setq source (list source-type source-file source-dir source-lib))) | 4274 | (setq source (list source-type source-file source-dir source-lib))) |
| 4275 | 4275 | ||
| 4276 | ;; The keywords | 4276 | ;; The keywords |
| 4277 | (setq kwds (mapcar (lambda (x) | 4277 | (setq kwds (mapcar (lambda (x) |
| 4278 | (idlwave-sintern-keyword-list x set)) | 4278 | (idlwave-sintern-keyword-list x set)) |
| @@ -4407,15 +4407,15 @@ will re-read the catalog." | |||
| 4407 | (not (stringp idlwave-user-catalog-file)) | 4407 | (not (stringp idlwave-user-catalog-file)) |
| 4408 | (not (file-regular-p idlwave-user-catalog-file))) | 4408 | (not (file-regular-p idlwave-user-catalog-file))) |
| 4409 | (error "No catalog has been produced yet")) | 4409 | (error "No catalog has been produced yet")) |
| 4410 | (let* ((emacs (expand-file-name (invocation-name) (invocation-directory))) | 4410 | (let* ((emacs (concat invocation-directory invocation-name)) |
| 4411 | (args (list "-batch" | 4411 | (args (list "-batch" |
| 4412 | "-l" (expand-file-name "~/.emacs") | 4412 | "-l" (expand-file-name "~/.emacs") |
| 4413 | "-l" "idlwave" | 4413 | "-l" "idlwave" |
| 4414 | "-f" "idlwave-rescan-catalog-directories")) | 4414 | "-f" "idlwave-rescan-catalog-directories")) |
| 4415 | (process (apply 'start-process "idlcat" | 4415 | (process (apply 'start-process "idlcat" |
| 4416 | nil emacs args))) | 4416 | nil emacs args))) |
| 4417 | (setq idlwave-catalog-process process) | 4417 | (setq idlwave-catalog-process process) |
| 4418 | (set-process-sentinel | 4418 | (set-process-sentinel |
| 4419 | process | 4419 | process |
| 4420 | (lambda (pro why) | 4420 | (lambda (pro why) |
| 4421 | (when (string-match "finished" why) | 4421 | (when (string-match "finished" why) |
| @@ -4432,7 +4432,7 @@ will re-read the catalog." | |||
| 4432 | ;; ("ROUTINE" type class | 4432 | ;; ("ROUTINE" type class |
| 4433 | ;; (system) | (lib pro_file dir "LIBNAME") | (user pro_file dir "USERLIB") | | 4433 | ;; (system) | (lib pro_file dir "LIBNAME") | (user pro_file dir "USERLIB") | |
| 4434 | ;; (buffer pro_file dir) | (compiled pro_file dir) | 4434 | ;; (buffer pro_file dir) | (compiled pro_file dir) |
| 4435 | ;; "calling_string" ("HELPFILE" (("KWD1" . link1) ...)) | 4435 | ;; "calling_string" ("HELPFILE" (("KWD1" . link1) ...)) |
| 4436 | ;; ("HELPFILE2" (("KWD2" . link) ...)) ...) | 4436 | ;; ("HELPFILE2" (("KWD2" . link) ...)) ...) |
| 4437 | ;; | 4437 | ;; |
| 4438 | ;; DIR will be supplied dynamically while loading library catalogs, | 4438 | ;; DIR will be supplied dynamically while loading library catalogs, |
| @@ -4491,7 +4491,7 @@ information updated immediately, leave NO-CONCATENATE nil." | |||
| 4491 | ;; The override-idle means, even if the idle timer has done some | 4491 | ;; The override-idle means, even if the idle timer has done some |
| 4492 | ;; preparing work, load and renormalize everything anyway. | 4492 | ;; preparing work, load and renormalize everything anyway. |
| 4493 | (override-idle (or arg idlwave-buffer-case-takes-precedence))) | 4493 | (override-idle (or arg idlwave-buffer-case-takes-precedence))) |
| 4494 | 4494 | ||
| 4495 | (setq idlwave-buffer-routines nil | 4495 | (setq idlwave-buffer-routines nil |
| 4496 | idlwave-compiled-routines nil | 4496 | idlwave-compiled-routines nil |
| 4497 | idlwave-unresolved-routines nil) | 4497 | idlwave-unresolved-routines nil) |
| @@ -4502,7 +4502,7 @@ information updated immediately, leave NO-CONCATENATE nil." | |||
| 4502 | (idlwave-reset-sintern (cond (load t) | 4502 | (idlwave-reset-sintern (cond (load t) |
| 4503 | ((null idlwave-system-routines) t) | 4503 | ((null idlwave-system-routines) t) |
| 4504 | (t 'bufsh)))) | 4504 | (t 'bufsh)))) |
| 4505 | 4505 | ||
| 4506 | (if idlwave-buffer-case-takes-precedence | 4506 | (if idlwave-buffer-case-takes-precedence |
| 4507 | ;; We can safely scan the buffer stuff first | 4507 | ;; We can safely scan the buffer stuff first |
| 4508 | (progn | 4508 | (progn |
| @@ -4517,9 +4517,9 @@ information updated immediately, leave NO-CONCATENATE nil." | |||
| 4517 | (idlwave-shell-is-running))) | 4517 | (idlwave-shell-is-running))) |
| 4518 | (ask-shell (and shell-is-running | 4518 | (ask-shell (and shell-is-running |
| 4519 | idlwave-query-shell-for-routine-info))) | 4519 | idlwave-query-shell-for-routine-info))) |
| 4520 | 4520 | ||
| 4521 | ;; Load the library catalogs again, first re-scanning the path | 4521 | ;; Load the library catalogs again, first re-scanning the path |
| 4522 | (when arg | 4522 | (when arg |
| 4523 | (if shell-is-running | 4523 | (if shell-is-running |
| 4524 | (idlwave-shell-send-command idlwave-shell-path-query | 4524 | (idlwave-shell-send-command idlwave-shell-path-query |
| 4525 | '(progn | 4525 | '(progn |
| @@ -4539,7 +4539,7 @@ information updated immediately, leave NO-CONCATENATE nil." | |||
| 4539 | ;; Therefore, we do a concatenation now, even though | 4539 | ;; Therefore, we do a concatenation now, even though |
| 4540 | ;; the shell might do it again. | 4540 | ;; the shell might do it again. |
| 4541 | (idlwave-concatenate-rinfo-lists nil 'run-hooks)) | 4541 | (idlwave-concatenate-rinfo-lists nil 'run-hooks)) |
| 4542 | 4542 | ||
| 4543 | (when ask-shell | 4543 | (when ask-shell |
| 4544 | ;; Ask the shell about the routines it knows of. | 4544 | ;; Ask the shell about the routines it knows of. |
| 4545 | (message "Querying the shell") | 4545 | (message "Querying the shell") |
| @@ -4576,26 +4576,26 @@ information updated immediately, leave NO-CONCATENATE nil." | |||
| 4576 | ;; which, if necessary, will be re-created from the XML file on | 4576 | ;; which, if necessary, will be re-created from the XML file on |
| 4577 | ;; disk. As a last fallback, load the (likely outdated) idlw-rinfo | 4577 | ;; disk. As a last fallback, load the (likely outdated) idlw-rinfo |
| 4578 | ;; file distributed with older IDLWAVE versions (<6.0) | 4578 | ;; file distributed with older IDLWAVE versions (<6.0) |
| 4579 | (unless (and (load idlwave-xml-system-rinfo-converted-file | 4579 | (unless (and (load idlwave-xml-system-rinfo-converted-file |
| 4580 | 'noerror 'nomessage) | 4580 | 'noerror 'nomessage) |
| 4581 | (idlwave-xml-system-routine-info-up-to-date)) | 4581 | (idlwave-xml-system-routine-info-up-to-date)) |
| 4582 | ;; See if we can create it from XML source | 4582 | ;; See if we can create it from XML source |
| 4583 | (condition-case nil | 4583 | (condition-case nil |
| 4584 | (idlwave-convert-xml-system-routine-info) | 4584 | (idlwave-convert-xml-system-routine-info) |
| 4585 | (error | 4585 | (error |
| 4586 | (unless (load idlwave-xml-system-rinfo-converted-file | 4586 | (unless (load idlwave-xml-system-rinfo-converted-file |
| 4587 | 'noerror 'nomessage) | 4587 | 'noerror 'nomessage) |
| 4588 | (if idlwave-system-routines | 4588 | (if idlwave-system-routines |
| 4589 | (message | 4589 | (message |
| 4590 | "Failed to load converted routine info, using old conversion.") | 4590 | "Failed to load converted routine info, using old conversion.") |
| 4591 | (message | 4591 | (message |
| 4592 | "Failed to convert XML routine info, falling back on idlw-rinfo.") | 4592 | "Failed to convert XML routine info, falling back on idlw-rinfo.") |
| 4593 | (if (not (load "idlw-rinfo" 'noerror 'nomessage)) | 4593 | (if (not (load "idlw-rinfo" 'noerror 'nomessage)) |
| 4594 | (message | 4594 | (message |
| 4595 | "Could not locate any system routine information.")))))))) | 4595 | "Could not locate any system routine information.")))))))) |
| 4596 | 4596 | ||
| 4597 | (defun idlwave-xml-system-routine-info-up-to-date() | 4597 | (defun idlwave-xml-system-routine-info-up-to-date() |
| 4598 | (let* ((dir (file-name-as-directory | 4598 | (let* ((dir (file-name-as-directory |
| 4599 | (expand-file-name "help/online_help" (idlwave-sys-dir)))) | 4599 | (expand-file-name "help/online_help" (idlwave-sys-dir)))) |
| 4600 | (catalog-file (expand-file-name "idl_catalog.xml" dir))) | 4600 | (catalog-file (expand-file-name "idl_catalog.xml" dir))) |
| 4601 | (file-newer-than-file-p ;converted file is newer than catalog | 4601 | (file-newer-than-file-p ;converted file is newer than catalog |
| @@ -4610,15 +4610,15 @@ Gets set in cached XML rinfo, or `idlw-rinfo.el'.") | |||
| 4610 | "Alist of system variables and their help files.") | 4610 | "Alist of system variables and their help files.") |
| 4611 | (defvar idlwave-help-special-topic-words nil) | 4611 | (defvar idlwave-help-special-topic-words nil) |
| 4612 | 4612 | ||
| 4613 | 4613 | ||
| 4614 | (defun idlwave-shorten-syntax (syntax name &optional class) | 4614 | (defun idlwave-shorten-syntax (syntax name &optional class) |
| 4615 | ;; From a list of syntax statments, shorten with %s and group with "or" | 4615 | ;; From a list of syntax statments, shorten with %s and group with "or" |
| 4616 | (let ((case-fold-search t)) | 4616 | (let ((case-fold-search t)) |
| 4617 | (mapconcat | 4617 | (mapconcat |
| 4618 | (lambda (x) | 4618 | (lambda (x) |
| 4619 | (while (string-match name x) | 4619 | (while (string-match name x) |
| 4620 | (setq x (replace-match "%s" t t x))) | 4620 | (setq x (replace-match "%s" t t x))) |
| 4621 | (if class | 4621 | (if class |
| 4622 | (while (string-match class x) | 4622 | (while (string-match class x) |
| 4623 | (setq x (replace-match "%s" t t x)))) | 4623 | (setq x (replace-match "%s" t t x)))) |
| 4624 | x) | 4624 | x) |
| @@ -4670,8 +4670,8 @@ Gets set in cached XML rinfo, or `idlw-rinfo.el'.") | |||
| 4670 | (put 'set-props 'matched t) | 4670 | (put 'set-props 'matched t) |
| 4671 | set-props) | 4671 | set-props) |
| 4672 | (t nil))) | 4672 | (t nil))) |
| 4673 | (setq methods-entry | 4673 | (setq methods-entry |
| 4674 | (nconc (idlwave-xml-create-rinfo-list pelem class extra-kwds) | 4674 | (nconc (idlwave-xml-create-rinfo-list pelem class extra-kwds) |
| 4675 | methods-entry))) | 4675 | methods-entry))) |
| 4676 | (t))) | 4676 | (t))) |
| 4677 | (setq params (cdr params))) | 4677 | (setq params (cdr params))) |
| @@ -4681,12 +4681,12 @@ Gets set in cached XML rinfo, or `idlw-rinfo.el'.") | |||
| 4681 | ; (message "Failed to match GetProperty in class %s" class)) | 4681 | ; (message "Failed to match GetProperty in class %s" class)) |
| 4682 | ;(unless (get 'set-props 'matched) | 4682 | ;(unless (get 'set-props 'matched) |
| 4683 | ; (message "Failed to match SetProperty in class %s" class)) | 4683 | ; (message "Failed to match SetProperty in class %s" class)) |
| 4684 | (setq class-entry | 4684 | (setq class-entry |
| 4685 | (if inherits | 4685 | (if inherits |
| 4686 | (list class (append '(inherits) inherits) (list 'link link)) | 4686 | (list class (append '(inherits) inherits) (list 'link link)) |
| 4687 | (list class (list 'link link)))) | 4687 | (list class (list 'link link)))) |
| 4688 | (cons class-entry methods-entry))) | 4688 | (cons class-entry methods-entry))) |
| 4689 | 4689 | ||
| 4690 | (defun idlwave-xml-create-rinfo-list (xml-entry &optional class extra-kws) | 4690 | (defun idlwave-xml-create-rinfo-list (xml-entry &optional class extra-kws) |
| 4691 | ;; Create correctly structured list elements from ROUTINE or METHOD | 4691 | ;; Create correctly structured list elements from ROUTINE or METHOD |
| 4692 | ;; XML list structures. Return a list of list elements, with more | 4692 | ;; XML list structures. Return a list of list elements, with more |
| @@ -4722,8 +4722,8 @@ Gets set in cached XML rinfo, or `idlw-rinfo.el'.") | |||
| 4722 | (setq kwd (cdr (assq 'name props)) | 4722 | (setq kwd (cdr (assq 'name props)) |
| 4723 | klink (cdr (assq 'link props))) | 4723 | klink (cdr (assq 'link props))) |
| 4724 | (if (string-match "^\\[XY\\(Z?\\)\\]" kwd) | 4724 | (if (string-match "^\\[XY\\(Z?\\)\\]" kwd) |
| 4725 | (progn | 4725 | (progn |
| 4726 | (setq pref-list | 4726 | (setq pref-list |
| 4727 | (if (match-string 1 kwd) '("X" "Y" "Z") '("X" "Y")) | 4727 | (if (match-string 1 kwd) '("X" "Y" "Z") '("X" "Y")) |
| 4728 | kwd (substring kwd (match-end 0))) | 4728 | kwd (substring kwd (match-end 0))) |
| 4729 | (loop for x in pref-list do | 4729 | (loop for x in pref-list do |
| @@ -4732,7 +4732,7 @@ Gets set in cached XML rinfo, or `idlw-rinfo.el'.") | |||
| 4732 | 4732 | ||
| 4733 | (t))); Do nothing for the others | 4733 | (t))); Do nothing for the others |
| 4734 | (setq params (cdr params))) | 4734 | (setq params (cdr params))) |
| 4735 | 4735 | ||
| 4736 | ;; Debug | 4736 | ;; Debug |
| 4737 | ; (if (and (null (aref syntax-vec 0)) | 4737 | ; (if (and (null (aref syntax-vec 0)) |
| 4738 | ; (null (aref syntax-vec 1)) | 4738 | ; (null (aref syntax-vec 1)) |
| @@ -4749,16 +4749,16 @@ Gets set in cached XML rinfo, or `idlw-rinfo.el'.") | |||
| 4749 | (setq kwds (idlwave-rinfo-group-keywords kwds link)) | 4749 | (setq kwds (idlwave-rinfo-group-keywords kwds link)) |
| 4750 | (loop for idx from 0 to 1 do | 4750 | (loop for idx from 0 to 1 do |
| 4751 | (if (aref syntax-vec idx) | 4751 | (if (aref syntax-vec idx) |
| 4752 | (push (append (list name (if (eq idx 0) 'pro 'fun) | 4752 | (push (append (list name (if (eq idx 0) 'pro 'fun) |
| 4753 | class '(system) | 4753 | class '(system) |
| 4754 | (idlwave-shorten-syntax | 4754 | (idlwave-shorten-syntax |
| 4755 | (aref syntax-vec idx) name class)) | 4755 | (aref syntax-vec idx) name class)) |
| 4756 | kwds) result))) | 4756 | kwds) result))) |
| 4757 | result))) | 4757 | result))) |
| 4758 | 4758 | ||
| 4759 | 4759 | ||
| 4760 | (defun idlwave-rinfo-group-keywords (kwds master-link) | 4760 | (defun idlwave-rinfo-group-keywords (kwds master-link) |
| 4761 | ;; Group keywords by link file, as a list with elements | 4761 | ;; Group keywords by link file, as a list with elements |
| 4762 | ;; (linkfile ( ("KWD1" . link1) ("KWD2" . link2)) | 4762 | ;; (linkfile ( ("KWD1" . link1) ("KWD2" . link2)) |
| 4763 | (let (kwd link anchor linkfiles block master-elt) | 4763 | (let (kwd link anchor linkfiles block master-elt) |
| 4764 | (while kwds | 4764 | (while kwds |
| @@ -4777,7 +4777,7 @@ Gets set in cached XML rinfo, or `idlw-rinfo.el'.") | |||
| 4777 | linkfiles | 4777 | linkfiles |
| 4778 | (cons master-elt (delq master-elt linkfiles))) | 4778 | (cons master-elt (delq master-elt linkfiles))) |
| 4779 | (push (list master-link) linkfiles)))) | 4779 | (push (list master-link) linkfiles)))) |
| 4780 | 4780 | ||
| 4781 | (defun idlwave-convert-xml-clean-statement-aliases (aliases) | 4781 | (defun idlwave-convert-xml-clean-statement-aliases (aliases) |
| 4782 | ;; Clean up the syntax of routines which are actually aliases by | 4782 | ;; Clean up the syntax of routines which are actually aliases by |
| 4783 | ;; removing the "OR" from the statements | 4783 | ;; removing the "OR" from the statements |
| @@ -4790,7 +4790,7 @@ Gets set in cached XML rinfo, or `idlw-rinfo.el'.") | |||
| 4790 | 4790 | ||
| 4791 | (defun idlwave-convert-xml-clean-routine-aliases (aliases) | 4791 | (defun idlwave-convert-xml-clean-routine-aliases (aliases) |
| 4792 | ;; Duplicate and trim original routine aliases from rinfo list | 4792 | ;; Duplicate and trim original routine aliases from rinfo list |
| 4793 | ;; This if for, e.g. OPENR/OPENW/OPENU | 4793 | ;; This if for, e.g. OPENR/OPENW/OPENU |
| 4794 | (let (alias remove-list new parts all-parts) | 4794 | (let (alias remove-list new parts all-parts) |
| 4795 | (loop for x in aliases do | 4795 | (loop for x in aliases do |
| 4796 | (when (setq parts (split-string (cdr x) "/")) | 4796 | (when (setq parts (split-string (cdr x) "/")) |
| @@ -4799,7 +4799,7 @@ Gets set in cached XML rinfo, or `idlw-rinfo.el'.") | |||
| 4799 | (setq new (cons (cdr x) parts)) | 4799 | (setq new (cons (cdr x) parts)) |
| 4800 | (push new all-parts)) | 4800 | (push new all-parts)) |
| 4801 | (setcdr new (delete (car x) (cdr new))))) | 4801 | (setcdr new (delete (car x) (cdr new))))) |
| 4802 | 4802 | ||
| 4803 | ;; Add any missing aliases (separate by slashes) | 4803 | ;; Add any missing aliases (separate by slashes) |
| 4804 | (loop for x in all-parts do | 4804 | (loop for x in all-parts do |
| 4805 | (if (cdr x) | 4805 | (if (cdr x) |
| @@ -4843,7 +4843,7 @@ Gets set in cached XML rinfo, or `idlw-rinfo.el'.") | |||
| 4843 | props (car (cdr pelem))) | 4843 | props (car (cdr pelem))) |
| 4844 | (cond | 4844 | (cond |
| 4845 | ((eq ptype 'FIELD) | 4845 | ((eq ptype 'FIELD) |
| 4846 | (push (cons (cdr (assq 'name props)) | 4846 | (push (cons (cdr (assq 'name props)) |
| 4847 | (cdr | 4847 | (cdr |
| 4848 | (idlwave-split-link-target (cdr (assq 'link props))))) | 4848 | (idlwave-split-link-target (cdr (assq 'link props))))) |
| 4849 | tags)))) | 4849 | tags)))) |
| @@ -4857,10 +4857,10 @@ Gets set in cached XML rinfo, or `idlw-rinfo.el'.") | |||
| 4857 | (defun idlwave-save-routine-info () | 4857 | (defun idlwave-save-routine-info () |
| 4858 | (if idlwave-xml-routine-info-file | 4858 | (if idlwave-xml-routine-info-file |
| 4859 | (with-temp-file idlwave-xml-system-rinfo-converted-file | 4859 | (with-temp-file idlwave-xml-system-rinfo-converted-file |
| 4860 | (insert | 4860 | (insert |
| 4861 | (concat ";; *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-* | 4861 | (concat ";; *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-* |
| 4862 | ;; IDLWAVE Routine Information File (IDLWAVE version " idlwave-mode-version ") | 4862 | ;; IDLWAVE Routine Information File (IDLWAVE version " idlwave-mode-version ") |
| 4863 | ;; Automatically generated from source file: | 4863 | ;; Automatically generated from source file: |
| 4864 | ;; " idlwave-xml-routine-info-file " | 4864 | ;; " idlwave-xml-routine-info-file " |
| 4865 | ;; on " (current-time-string) " | 4865 | ;; on " (current-time-string) " |
| 4866 | ;; Do not edit.")) | 4866 | ;; Do not edit.")) |
| @@ -4886,11 +4886,11 @@ Gets set in cached XML rinfo, or `idlw-rinfo.el'.") | |||
| 4886 | "Convert XML supplied IDL routine info into internal form. | 4886 | "Convert XML supplied IDL routine info into internal form. |
| 4887 | Cache to disk for quick recovery." | 4887 | Cache to disk for quick recovery." |
| 4888 | (interactive) | 4888 | (interactive) |
| 4889 | (let* ((dir (file-name-as-directory | 4889 | (let* ((dir (file-name-as-directory |
| 4890 | (expand-file-name "help/online_help" (idlwave-sys-dir)))) | 4890 | (expand-file-name "help/online_help" (idlwave-sys-dir)))) |
| 4891 | (catalog-file (expand-file-name "idl_catalog.xml" dir)) | 4891 | (catalog-file (expand-file-name "idl_catalog.xml" dir)) |
| 4892 | (elem-cnt 0) | 4892 | (elem-cnt 0) |
| 4893 | props rinfo msg-cnt elem type nelem class-result alias | 4893 | props rinfo msg-cnt elem type nelem class-result alias |
| 4894 | routines routine-aliases statement-aliases sysvar-aliases | 4894 | routines routine-aliases statement-aliases sysvar-aliases |
| 4895 | buf version-string) | 4895 | buf version-string) |
| 4896 | (if (not (file-exists-p catalog-file)) | 4896 | (if (not (file-exists-p catalog-file)) |
| @@ -4898,7 +4898,7 @@ Cache to disk for quick recovery." | |||
| 4898 | (if (not (file-readable-p catalog-file)) | 4898 | (if (not (file-readable-p catalog-file)) |
| 4899 | (error "Cannot read XML routine info file: %s" catalog-file))) | 4899 | (error "Cannot read XML routine info file: %s" catalog-file))) |
| 4900 | (require 'xml) | 4900 | (require 'xml) |
| 4901 | (message "Reading XML routine info...") | 4901 | (message "Reading XML routine info...") |
| 4902 | (unwind-protect | 4902 | (unwind-protect |
| 4903 | (progn | 4903 | (progn |
| 4904 | ;; avoid warnings about read-only files | 4904 | ;; avoid warnings about read-only files |
| @@ -4909,13 +4909,13 @@ Cache to disk for quick recovery." | |||
| 4909 | (setq rinfo (assq 'CATALOG rinfo)) | 4909 | (setq rinfo (assq 'CATALOG rinfo)) |
| 4910 | (unless rinfo (error "Failed to parse XML routine info")) | 4910 | (unless rinfo (error "Failed to parse XML routine info")) |
| 4911 | ;;(setq rinfo (car rinfo)) ; Skip the catalog stuff. | 4911 | ;;(setq rinfo (car rinfo)) ; Skip the catalog stuff. |
| 4912 | 4912 | ||
| 4913 | (setq version-string (cdr (assq 'version (nth 1 rinfo))) | 4913 | (setq version-string (cdr (assq 'version (nth 1 rinfo))) |
| 4914 | rinfo (cddr rinfo)) | 4914 | rinfo (cddr rinfo)) |
| 4915 | 4915 | ||
| 4916 | (setq nelem (length rinfo) | 4916 | (setq nelem (length rinfo) |
| 4917 | msg-cnt (/ nelem 20)) | 4917 | msg-cnt (/ nelem 20)) |
| 4918 | 4918 | ||
| 4919 | (setq idlwave-xml-routine-info-file nil) | 4919 | (setq idlwave-xml-routine-info-file nil) |
| 4920 | (message "Converting XML routine info...") | 4920 | (message "Converting XML routine info...") |
| 4921 | (setq idlwave-system-routines nil | 4921 | (setq idlwave-system-routines nil |
| @@ -4932,12 +4932,12 @@ Cache to disk for quick recovery." | |||
| 4932 | (setq type (car elem) | 4932 | (setq type (car elem) |
| 4933 | props (car (cdr elem))) | 4933 | props (car (cdr elem))) |
| 4934 | (if (= (mod elem-cnt msg-cnt) 0) | 4934 | (if (= (mod elem-cnt msg-cnt) 0) |
| 4935 | (message "Converting XML routine info...%2d%%" | 4935 | (message "Converting XML routine info...%2d%%" |
| 4936 | (/ (* elem-cnt 100) nelem))) | 4936 | (/ (* elem-cnt 100) nelem))) |
| 4937 | (cond | 4937 | (cond |
| 4938 | ((eq type 'ROUTINE) | 4938 | ((eq type 'ROUTINE) |
| 4939 | (if (setq alias (assq 'alias_to props)) | 4939 | (if (setq alias (assq 'alias_to props)) |
| 4940 | (push (cons (cdr (assq 'name props)) (cdr alias)) | 4940 | (push (cons (cdr (assq 'name props)) (cdr alias)) |
| 4941 | routine-aliases) | 4941 | routine-aliases) |
| 4942 | (setq routines (idlwave-xml-create-rinfo-list elem)) | 4942 | (setq routines (idlwave-xml-create-rinfo-list elem)) |
| 4943 | (if (listp (cdr routines)) | 4943 | (if (listp (cdr routines)) |
| @@ -4945,7 +4945,7 @@ Cache to disk for quick recovery." | |||
| 4945 | (nconc idlwave-system-routines routines)) | 4945 | (nconc idlwave-system-routines routines)) |
| 4946 | ;; a cons cell is an executive commands | 4946 | ;; a cons cell is an executive commands |
| 4947 | (push routines idlwave-executive-commands-alist)))) | 4947 | (push routines idlwave-executive-commands-alist)))) |
| 4948 | 4948 | ||
| 4949 | ((eq type 'CLASS) | 4949 | ((eq type 'CLASS) |
| 4950 | (setq class-result (idlwave-xml-create-class-method-lists elem)) | 4950 | (setq class-result (idlwave-xml-create-class-method-lists elem)) |
| 4951 | (push (car class-result) idlwave-system-class-info) | 4951 | (push (car class-result) idlwave-system-class-info) |
| @@ -4963,10 +4963,10 @@ Cache to disk for quick recovery." | |||
| 4963 | 4963 | ||
| 4964 | ((eq type 'SYSVAR) | 4964 | ((eq type 'SYSVAR) |
| 4965 | (if (setq alias (cdr (assq 'alias_to props))) | 4965 | (if (setq alias (cdr (assq 'alias_to props))) |
| 4966 | (push (cons (substring (cdr (assq 'name props)) 1) | 4966 | (push (cons (substring (cdr (assq 'name props)) 1) |
| 4967 | (substring alias 1)) | 4967 | (substring alias 1)) |
| 4968 | sysvar-aliases) | 4968 | sysvar-aliases) |
| 4969 | (push (idlwave-xml-create-sysvar-alist elem) | 4969 | (push (idlwave-xml-create-sysvar-alist elem) |
| 4970 | idlwave-system-variables-alist))) | 4970 | idlwave-system-variables-alist))) |
| 4971 | (t)))) | 4971 | (t)))) |
| 4972 | (idlwave-convert-xml-clean-routine-aliases routine-aliases) | 4972 | (idlwave-convert-xml-clean-routine-aliases routine-aliases) |
| @@ -4976,12 +4976,12 @@ Cache to disk for quick recovery." | |||
| 4976 | (setq idlwave-xml-routine-info-file catalog-file) | 4976 | (setq idlwave-xml-routine-info-file catalog-file) |
| 4977 | (idlwave-save-routine-info) | 4977 | (idlwave-save-routine-info) |
| 4978 | (message "Converting XML routine info...done"))) | 4978 | (message "Converting XML routine info...done"))) |
| 4979 | 4979 | ||
| 4980 | 4980 | ||
| 4981 | ;; ("ROUTINE" type class | 4981 | ;; ("ROUTINE" type class |
| 4982 | ;; (system) | (lib pro_file dir "LIBNAME") | (user pro_file dir "USERLIB") | | 4982 | ;; (system) | (lib pro_file dir "LIBNAME") | (user pro_file dir "USERLIB") | |
| 4983 | ;; (buffer pro_file dir) | (compiled pro_file dir) | 4983 | ;; (buffer pro_file dir) | (compiled pro_file dir) |
| 4984 | ;; "calling_string" ("HELPFILE" (("KWD1" . link1) ...)) | 4984 | ;; "calling_string" ("HELPFILE" (("KWD1" . link1) ...)) |
| 4985 | ;; ("HELPFILE2" (("KWD2" . link) ...)) ...) | 4985 | ;; ("HELPFILE2" (("KWD2" . link) ...)) ...) |
| 4986 | 4986 | ||
| 4987 | 4987 | ||
| @@ -4996,7 +4996,7 @@ Cache to disk for quick recovery." | |||
| 4996 | (message "Loading system routine info in idle time...done") | 4996 | (message "Loading system routine info in idle time...done") |
| 4997 | (aset arr 0 t) | 4997 | (aset arr 0 t) |
| 4998 | (throw 'exit t)) | 4998 | (throw 'exit t)) |
| 4999 | 4999 | ||
| 5000 | (when (not (aref arr 1)) | 5000 | (when (not (aref arr 1)) |
| 5001 | (message "Normalizing idlwave-system-routines in idle time...") | 5001 | (message "Normalizing idlwave-system-routines in idle time...") |
| 5002 | (idlwave-reset-sintern t) | 5002 | (idlwave-reset-sintern t) |
| @@ -5021,7 +5021,7 @@ Cache to disk for quick recovery." | |||
| 5021 | (progn | 5021 | (progn |
| 5022 | (setq idlwave-library-routines nil) | 5022 | (setq idlwave-library-routines nil) |
| 5023 | (ding) | 5023 | (ding) |
| 5024 | (message "Outdated user catalog: %s... recreate" | 5024 | (message "Outdated user catalog: %s... recreate" |
| 5025 | idlwave-user-catalog-file)) | 5025 | idlwave-user-catalog-file)) |
| 5026 | (message "Loading user catalog in idle time...done"))) | 5026 | (message "Loading user catalog in idle time...done"))) |
| 5027 | (aset arr 2 t) | 5027 | (aset arr 2 t) |
| @@ -5030,16 +5030,16 @@ Cache to disk for quick recovery." | |||
| 5030 | (when (not (aref arr 3)) | 5030 | (when (not (aref arr 3)) |
| 5031 | (when idlwave-user-catalog-routines | 5031 | (when idlwave-user-catalog-routines |
| 5032 | (message "Normalizing user catalog routines in idle time...") | 5032 | (message "Normalizing user catalog routines in idle time...") |
| 5033 | (setq idlwave-user-catalog-routines | 5033 | (setq idlwave-user-catalog-routines |
| 5034 | (idlwave-sintern-rinfo-list | 5034 | (idlwave-sintern-rinfo-list |
| 5035 | idlwave-user-catalog-routines 'sys)) | 5035 | idlwave-user-catalog-routines 'sys)) |
| 5036 | (message | 5036 | (message |
| 5037 | "Normalizing user catalog routines in idle time...done")) | 5037 | "Normalizing user catalog routines in idle time...done")) |
| 5038 | (aset arr 3 t) | 5038 | (aset arr 3 t) |
| 5039 | (throw 'exit t)) | 5039 | (throw 'exit t)) |
| 5040 | 5040 | ||
| 5041 | (when (not (aref arr 4)) | 5041 | (when (not (aref arr 4)) |
| 5042 | (idlwave-scan-library-catalogs | 5042 | (idlwave-scan-library-catalogs |
| 5043 | "Loading and normalizing library catalogs in idle time...") | 5043 | "Loading and normalizing library catalogs in idle time...") |
| 5044 | (aset arr 4 t) | 5044 | (aset arr 4 t) |
| 5045 | (throw 'exit t)) | 5045 | (throw 'exit t)) |
| @@ -5047,7 +5047,7 @@ Cache to disk for quick recovery." | |||
| 5047 | (message "Finishing initialization in idle time...") | 5047 | (message "Finishing initialization in idle time...") |
| 5048 | (idlwave-routines) | 5048 | (idlwave-routines) |
| 5049 | (message "Finishing initialization in idle time...done") | 5049 | (message "Finishing initialization in idle time...done") |
| 5050 | (aset arr 5 t) | 5050 | (aset arr 5 t) |
| 5051 | (throw 'exit nil))) | 5051 | (throw 'exit nil))) |
| 5052 | ;; restart the timer | 5052 | ;; restart the timer |
| 5053 | (if (sit-for 1) | 5053 | (if (sit-for 1) |
| @@ -5082,17 +5082,17 @@ Cache to disk for quick recovery." | |||
| 5082 | (when (or force (not (aref idlwave-load-rinfo-steps-done 2))) | 5082 | (when (or force (not (aref idlwave-load-rinfo-steps-done 2))) |
| 5083 | (load-file idlwave-user-catalog-file)) | 5083 | (load-file idlwave-user-catalog-file)) |
| 5084 | (error nil)) | 5084 | (error nil)) |
| 5085 | (when (and | 5085 | (when (and |
| 5086 | (boundp 'idlwave-library-routines) | 5086 | (boundp 'idlwave-library-routines) |
| 5087 | idlwave-library-routines) | 5087 | idlwave-library-routines) |
| 5088 | (setq idlwave-library-routines nil) | 5088 | (setq idlwave-library-routines nil) |
| 5089 | (error "Outdated user catalog: %s... recreate" | 5089 | (error "Outdated user catalog: %s... recreate" |
| 5090 | idlwave-user-catalog-file)) | 5090 | idlwave-user-catalog-file)) |
| 5091 | (setq idlwave-true-path-alist nil) | 5091 | (setq idlwave-true-path-alist nil) |
| 5092 | (when (or force (not (aref idlwave-load-rinfo-steps-done 3))) | 5092 | (when (or force (not (aref idlwave-load-rinfo-steps-done 3))) |
| 5093 | (message "Normalizing user catalog routines...") | 5093 | (message "Normalizing user catalog routines...") |
| 5094 | (setq idlwave-user-catalog-routines | 5094 | (setq idlwave-user-catalog-routines |
| 5095 | (idlwave-sintern-rinfo-list | 5095 | (idlwave-sintern-rinfo-list |
| 5096 | idlwave-user-catalog-routines 'sys)) | 5096 | idlwave-user-catalog-routines 'sys)) |
| 5097 | (message "Normalizing user catalog routines...done"))) | 5097 | (message "Normalizing user catalog routines...done"))) |
| 5098 | 5098 | ||
| @@ -5105,11 +5105,11 @@ Cache to disk for quick recovery." | |||
| 5105 | 5105 | ||
| 5106 | (defun idlwave-update-buffer-routine-info () | 5106 | (defun idlwave-update-buffer-routine-info () |
| 5107 | (let (res) | 5107 | (let (res) |
| 5108 | (cond | 5108 | (cond |
| 5109 | ((eq idlwave-scan-all-buffers-for-routine-info t) | 5109 | ((eq idlwave-scan-all-buffers-for-routine-info t) |
| 5110 | ;; Scan all buffers, current buffer last | 5110 | ;; Scan all buffers, current buffer last |
| 5111 | (message "Scanning all buffers...") | 5111 | (message "Scanning all buffers...") |
| 5112 | (setq res (idlwave-get-routine-info-from-buffers | 5112 | (setq res (idlwave-get-routine-info-from-buffers |
| 5113 | (reverse (buffer-list))))) | 5113 | (reverse (buffer-list))))) |
| 5114 | ((null idlwave-scan-all-buffers-for-routine-info) | 5114 | ((null idlwave-scan-all-buffers-for-routine-info) |
| 5115 | ;; Don't scan any buffers | 5115 | ;; Don't scan any buffers |
| @@ -5122,12 +5122,12 @@ Cache to disk for quick recovery." | |||
| 5122 | (setq res (idlwave-get-routine-info-from-buffers | 5122 | (setq res (idlwave-get-routine-info-from-buffers |
| 5123 | (list (current-buffer)))))))) | 5123 | (list (current-buffer)))))))) |
| 5124 | ;; Put the result into the correct variable | 5124 | ;; Put the result into the correct variable |
| 5125 | (setq idlwave-buffer-routines | 5125 | (setq idlwave-buffer-routines |
| 5126 | (idlwave-sintern-rinfo-list res 'set)))) | 5126 | (idlwave-sintern-rinfo-list res 'set)))) |
| 5127 | 5127 | ||
| 5128 | (defun idlwave-concatenate-rinfo-lists (&optional quiet run-hook) | 5128 | (defun idlwave-concatenate-rinfo-lists (&optional quiet run-hook) |
| 5129 | "Put the different sources for routine information together." | 5129 | "Put the different sources for routine information together." |
| 5130 | ;; The sequence here is important because earlier definitions shadow | 5130 | ;; The sequence here is important because earlier definitions shadow |
| 5131 | ;; later ones. We assume that if things in the buffers are newer | 5131 | ;; later ones. We assume that if things in the buffers are newer |
| 5132 | ;; then in the shell of the system, they are meant to be different. | 5132 | ;; then in the shell of the system, they are meant to be different. |
| 5133 | (setcdr idlwave-last-system-routine-info-cons-cell | 5133 | (setcdr idlwave-last-system-routine-info-cons-cell |
| @@ -5139,7 +5139,7 @@ Cache to disk for quick recovery." | |||
| 5139 | 5139 | ||
| 5140 | ;; Give a message with information about the number of routines we have. | 5140 | ;; Give a message with information about the number of routines we have. |
| 5141 | (unless quiet | 5141 | (unless quiet |
| 5142 | (message | 5142 | (message |
| 5143 | "Routines Found: buffer(%d) compiled(%d) library(%d) user(%d) system(%d)" | 5143 | "Routines Found: buffer(%d) compiled(%d) library(%d) user(%d) system(%d)" |
| 5144 | (length idlwave-buffer-routines) | 5144 | (length idlwave-buffer-routines) |
| 5145 | (length idlwave-compiled-routines) | 5145 | (length idlwave-compiled-routines) |
| @@ -5157,7 +5157,7 @@ Cache to disk for quick recovery." | |||
| 5157 | (when (and (setq class (nth 2 x)) | 5157 | (when (and (setq class (nth 2 x)) |
| 5158 | (not (assq class idlwave-class-alist))) | 5158 | (not (assq class idlwave-class-alist))) |
| 5159 | (push (list class) idlwave-class-alist))) | 5159 | (push (list class) idlwave-class-alist))) |
| 5160 | idlwave-class-alist))) | 5160 | idlwave-class-alist))) |
| 5161 | 5161 | ||
| 5162 | ;; Three functions for the hooks | 5162 | ;; Three functions for the hooks |
| 5163 | (defun idlwave-save-buffer-update () | 5163 | (defun idlwave-save-buffer-update () |
| @@ -5190,7 +5190,7 @@ Cache to disk for quick recovery." | |||
| 5190 | 5190 | ||
| 5191 | (defun idlwave-replace-buffer-routine-info (file new) | 5191 | (defun idlwave-replace-buffer-routine-info (file new) |
| 5192 | "Cut the part from FILE out of `idlwave-buffer-routines' and add NEW." | 5192 | "Cut the part from FILE out of `idlwave-buffer-routines' and add NEW." |
| 5193 | (let ((list idlwave-buffer-routines) | 5193 | (let ((list idlwave-buffer-routines) |
| 5194 | found) | 5194 | found) |
| 5195 | (while list | 5195 | (while list |
| 5196 | ;; The following test uses eq to make sure it works correctly | 5196 | ;; The following test uses eq to make sure it works correctly |
| @@ -5201,7 +5201,7 @@ Cache to disk for quick recovery." | |||
| 5201 | (setcar list nil) | 5201 | (setcar list nil) |
| 5202 | (setq found t)) | 5202 | (setq found t)) |
| 5203 | (if found | 5203 | (if found |
| 5204 | ;; End of that section reached. Jump. | 5204 | ;; End of that section reached. Jump. |
| 5205 | (setq list nil))) | 5205 | (setq list nil))) |
| 5206 | (setq list (cdr list))) | 5206 | (setq list (cdr list))) |
| 5207 | (setq idlwave-buffer-routines | 5207 | (setq idlwave-buffer-routines |
| @@ -5233,11 +5233,11 @@ Cache to disk for quick recovery." | |||
| 5233 | (save-restriction | 5233 | (save-restriction |
| 5234 | (widen) | 5234 | (widen) |
| 5235 | (goto-char (point-min)) | 5235 | (goto-char (point-min)) |
| 5236 | (while (re-search-forward | 5236 | (while (re-search-forward |
| 5237 | "^[ \t]*\\(pro\\|function\\)[ \t]" nil t) | 5237 | "^[ \t]*\\(pro\\|function\\)[ \t]" nil t) |
| 5238 | (setq string (buffer-substring-no-properties | 5238 | (setq string (buffer-substring-no-properties |
| 5239 | (match-beginning 0) | 5239 | (match-beginning 0) |
| 5240 | (progn | 5240 | (progn |
| 5241 | (idlwave-end-of-statement) | 5241 | (idlwave-end-of-statement) |
| 5242 | (point)))) | 5242 | (point)))) |
| 5243 | (setq entry (idlwave-parse-definition string)) | 5243 | (setq entry (idlwave-parse-definition string)) |
| @@ -5275,7 +5275,7 @@ Cache to disk for quick recovery." | |||
| 5275 | (push (match-string 1 string) args))) | 5275 | (push (match-string 1 string) args))) |
| 5276 | ;; Normalize and sort. | 5276 | ;; Normalize and sort. |
| 5277 | (setq args (nreverse args)) | 5277 | (setq args (nreverse args)) |
| 5278 | (setq keywords (sort keywords (lambda (a b) | 5278 | (setq keywords (sort keywords (lambda (a b) |
| 5279 | (string< (downcase a) (downcase b))))) | 5279 | (string< (downcase a) (downcase b))))) |
| 5280 | ;; Make and return the entry | 5280 | ;; Make and return the entry |
| 5281 | ;; We don't know which argument are optional, so this information | 5281 | ;; We don't know which argument are optional, so this information |
| @@ -5285,7 +5285,7 @@ Cache to disk for quick recovery." | |||
| 5285 | class | 5285 | class |
| 5286 | (cond ((not (boundp 'idlwave-scanning-lib)) | 5286 | (cond ((not (boundp 'idlwave-scanning-lib)) |
| 5287 | (list 'buffer (buffer-file-name))) | 5287 | (list 'buffer (buffer-file-name))) |
| 5288 | ; ((string= (downcase | 5288 | ; ((string= (downcase |
| 5289 | ; (file-name-sans-extension | 5289 | ; (file-name-sans-extension |
| 5290 | ; (file-name-nondirectory (buffer-file-name)))) | 5290 | ; (file-name-nondirectory (buffer-file-name)))) |
| 5291 | ; (downcase name)) | 5291 | ; (downcase name)) |
| @@ -5293,7 +5293,7 @@ Cache to disk for quick recovery." | |||
| 5293 | ; (t (cons 'lib (file-name-nondirectory (buffer-file-name)))) | 5293 | ; (t (cons 'lib (file-name-nondirectory (buffer-file-name)))) |
| 5294 | (t (list 'user (file-name-nondirectory (buffer-file-name)) | 5294 | (t (list 'user (file-name-nondirectory (buffer-file-name)) |
| 5295 | idlwave-scanning-lib-dir "UserLib"))) | 5295 | idlwave-scanning-lib-dir "UserLib"))) |
| 5296 | (concat | 5296 | (concat |
| 5297 | (if (string= type "function") "Result = " "") | 5297 | (if (string= type "function") "Result = " "") |
| 5298 | (if class "Obj ->[%s::]" "") | 5298 | (if class "Obj ->[%s::]" "") |
| 5299 | "%s" | 5299 | "%s" |
| @@ -5339,10 +5339,10 @@ time - so no widget will pop up." | |||
| 5339 | (> (length idlwave-user-catalog-file) 0) | 5339 | (> (length idlwave-user-catalog-file) 0) |
| 5340 | (file-accessible-directory-p | 5340 | (file-accessible-directory-p |
| 5341 | (file-name-directory idlwave-user-catalog-file)) | 5341 | (file-name-directory idlwave-user-catalog-file)) |
| 5342 | (not (string= "" (file-name-nondirectory | 5342 | (not (string= "" (file-name-nondirectory |
| 5343 | idlwave-user-catalog-file)))) | 5343 | idlwave-user-catalog-file)))) |
| 5344 | (error "`idlwave-user-catalog-file' does not point to a file in an accessible directory")) | 5344 | (error "`idlwave-user-catalog-file' does not point to a file in an accessible directory")) |
| 5345 | 5345 | ||
| 5346 | (cond | 5346 | (cond |
| 5347 | ;; Rescan the known directories | 5347 | ;; Rescan the known directories |
| 5348 | ((and arg idlwave-path-alist | 5348 | ((and arg idlwave-path-alist |
| @@ -5352,13 +5352,13 @@ time - so no widget will pop up." | |||
| 5352 | ;; Expand the directories from library-path and run the widget | 5352 | ;; Expand the directories from library-path and run the widget |
| 5353 | (idlwave-library-path | 5353 | (idlwave-library-path |
| 5354 | (idlwave-display-user-catalog-widget | 5354 | (idlwave-display-user-catalog-widget |
| 5355 | (if idlwave-true-path-alist | 5355 | (if idlwave-true-path-alist |
| 5356 | ;; Propagate any flags on the existing path-alist | 5356 | ;; Propagate any flags on the existing path-alist |
| 5357 | (mapcar (lambda (x) | 5357 | (mapcar (lambda (x) |
| 5358 | (let ((path-entry (assoc (file-truename x) | 5358 | (let ((path-entry (assoc (file-truename x) |
| 5359 | idlwave-true-path-alist))) | 5359 | idlwave-true-path-alist))) |
| 5360 | (if path-entry | 5360 | (if path-entry |
| 5361 | (cons x (cdr path-entry)) | 5361 | (cons x (cdr path-entry)) |
| 5362 | (list x)))) | 5362 | (list x)))) |
| 5363 | (idlwave-expand-path idlwave-library-path)) | 5363 | (idlwave-expand-path idlwave-library-path)) |
| 5364 | (mapcar 'list (idlwave-expand-path idlwave-library-path))))) | 5364 | (mapcar 'list (idlwave-expand-path idlwave-library-path))))) |
| @@ -5383,7 +5383,7 @@ time - so no widget will pop up." | |||
| 5383 | (idlwave-scan-library-catalogs "Locating library catalogs..." 'no-load) | 5383 | (idlwave-scan-library-catalogs "Locating library catalogs..." 'no-load) |
| 5384 | (idlwave-display-user-catalog-widget idlwave-path-alist))) | 5384 | (idlwave-display-user-catalog-widget idlwave-path-alist))) |
| 5385 | 5385 | ||
| 5386 | (defconst idlwave-user-catalog-widget-help-string | 5386 | (defconst idlwave-user-catalog-widget-help-string |
| 5387 | "This is the front-end to the creation of the IDLWAVE user catalog. | 5387 | "This is the front-end to the creation of the IDLWAVE user catalog. |
| 5388 | Please select the directories on IDL's search path from which you | 5388 | Please select the directories on IDL's search path from which you |
| 5389 | would like to extract routine information, to be stored in the file: | 5389 | would like to extract routine information, to be stored in the file: |
| @@ -5418,7 +5418,7 @@ directories and save the routine info. | |||
| 5418 | (make-local-variable 'idlwave-widget) | 5418 | (make-local-variable 'idlwave-widget) |
| 5419 | (widget-insert (format idlwave-user-catalog-widget-help-string | 5419 | (widget-insert (format idlwave-user-catalog-widget-help-string |
| 5420 | idlwave-user-catalog-file)) | 5420 | idlwave-user-catalog-file)) |
| 5421 | 5421 | ||
| 5422 | (widget-create 'push-button | 5422 | (widget-create 'push-button |
| 5423 | :notify 'idlwave-widget-scan-user-lib-files | 5423 | :notify 'idlwave-widget-scan-user-lib-files |
| 5424 | "Scan & Save") | 5424 | "Scan & Save") |
| @@ -5428,7 +5428,7 @@ directories and save the routine info. | |||
| 5428 | "Delete File") | 5428 | "Delete File") |
| 5429 | (widget-insert " ") | 5429 | (widget-insert " ") |
| 5430 | (widget-create 'push-button | 5430 | (widget-create 'push-button |
| 5431 | :notify | 5431 | :notify |
| 5432 | '(lambda (&rest ignore) | 5432 | '(lambda (&rest ignore) |
| 5433 | (let ((path-list (widget-get idlwave-widget :path-dirs))) | 5433 | (let ((path-list (widget-get idlwave-widget :path-dirs))) |
| 5434 | (mapcar (lambda (x) | 5434 | (mapcar (lambda (x) |
| @@ -5439,7 +5439,7 @@ directories and save the routine info. | |||
| 5439 | "Select All Non-Lib") | 5439 | "Select All Non-Lib") |
| 5440 | (widget-insert " ") | 5440 | (widget-insert " ") |
| 5441 | (widget-create 'push-button | 5441 | (widget-create 'push-button |
| 5442 | :notify | 5442 | :notify |
| 5443 | '(lambda (&rest ignore) | 5443 | '(lambda (&rest ignore) |
| 5444 | (let ((path-list (widget-get idlwave-widget :path-dirs))) | 5444 | (let ((path-list (widget-get idlwave-widget :path-dirs))) |
| 5445 | (mapcar (lambda (x) | 5445 | (mapcar (lambda (x) |
| @@ -5455,18 +5455,18 @@ directories and save the routine info. | |||
| 5455 | (widget-insert "\n\n") | 5455 | (widget-insert "\n\n") |
| 5456 | 5456 | ||
| 5457 | (widget-insert "Select Directories: \n") | 5457 | (widget-insert "Select Directories: \n") |
| 5458 | 5458 | ||
| 5459 | (setq idlwave-widget | 5459 | (setq idlwave-widget |
| 5460 | (apply 'widget-create | 5460 | (apply 'widget-create |
| 5461 | 'checklist | 5461 | 'checklist |
| 5462 | :value (delq nil (mapcar (lambda (x) | 5462 | :value (delq nil (mapcar (lambda (x) |
| 5463 | (if (memq 'user (cdr x)) | 5463 | (if (memq 'user (cdr x)) |
| 5464 | (car x))) | 5464 | (car x))) |
| 5465 | dirs-list)) | 5465 | dirs-list)) |
| 5466 | :greedy t | 5466 | :greedy t |
| 5467 | :tag "List of directories" | 5467 | :tag "List of directories" |
| 5468 | (mapcar (lambda (x) | 5468 | (mapcar (lambda (x) |
| 5469 | (list 'item | 5469 | (list 'item |
| 5470 | (if (memq 'lib (cdr x)) | 5470 | (if (memq 'lib (cdr x)) |
| 5471 | (concat "[LIB] " (car x) ) | 5471 | (concat "[LIB] " (car x) ) |
| 5472 | (car x)))) dirs-list))) | 5472 | (car x)))) dirs-list))) |
| @@ -5476,7 +5476,7 @@ directories and save the routine info. | |||
| 5476 | (widget-setup) | 5476 | (widget-setup) |
| 5477 | (goto-char (point-min)) | 5477 | (goto-char (point-min)) |
| 5478 | (delete-other-windows)) | 5478 | (delete-other-windows)) |
| 5479 | 5479 | ||
| 5480 | (defun idlwave-delete-user-catalog-file (&rest ignore) | 5480 | (defun idlwave-delete-user-catalog-file (&rest ignore) |
| 5481 | (if (yes-or-no-p | 5481 | (if (yes-or-no-p |
| 5482 | (format "Delete file %s " idlwave-user-catalog-file)) | 5482 | (format "Delete file %s " idlwave-user-catalog-file)) |
| @@ -5492,7 +5492,7 @@ directories and save the routine info. | |||
| 5492 | (this-path-alist path-alist) | 5492 | (this-path-alist path-alist) |
| 5493 | dir-entry) | 5493 | dir-entry) |
| 5494 | (while (setq dir-entry (pop this-path-alist)) | 5494 | (while (setq dir-entry (pop this-path-alist)) |
| 5495 | (if (member | 5495 | (if (member |
| 5496 | (if (memq 'lib (cdr dir-entry)) | 5496 | (if (memq 'lib (cdr dir-entry)) |
| 5497 | (concat "[LIB] " (car dir-entry)) | 5497 | (concat "[LIB] " (car dir-entry)) |
| 5498 | (car dir-entry)) | 5498 | (car dir-entry)) |
| @@ -5589,7 +5589,7 @@ directories and save the routine info. | |||
| 5589 | ;; Define the variable which knows the value of "!DIR" | 5589 | ;; Define the variable which knows the value of "!DIR" |
| 5590 | (insert (format "\n(setq idlwave-system-directory \"%s\")\n" | 5590 | (insert (format "\n(setq idlwave-system-directory \"%s\")\n" |
| 5591 | idlwave-system-directory)) | 5591 | idlwave-system-directory)) |
| 5592 | 5592 | ||
| 5593 | ;; Define the variable which contains a list of all scanned directories | 5593 | ;; Define the variable which contains a list of all scanned directories |
| 5594 | (insert "\n(setq idlwave-path-alist\n '(") | 5594 | (insert "\n(setq idlwave-path-alist\n '(") |
| 5595 | (let ((standard-output (current-buffer))) | 5595 | (let ((standard-output (current-buffer))) |
| @@ -5629,7 +5629,7 @@ directories and save the routine info. | |||
| 5629 | (when (file-directory-p dir) | 5629 | (when (file-directory-p dir) |
| 5630 | (setq files (nreverse (directory-files dir t "[^.]"))) | 5630 | (setq files (nreverse (directory-files dir t "[^.]"))) |
| 5631 | (while (setq file (pop files)) | 5631 | (while (setq file (pop files)) |
| 5632 | (if (file-directory-p file) | 5632 | (if (file-directory-p file) |
| 5633 | (push (file-name-as-directory file) path))) | 5633 | (push (file-name-as-directory file) path))) |
| 5634 | (push dir path1))) | 5634 | (push dir path1))) |
| 5635 | path1)) | 5635 | path1)) |
| @@ -5641,7 +5641,7 @@ directories and save the routine info. | |||
| 5641 | 5641 | ||
| 5642 | 5642 | ||
| 5643 | (defun idlwave-scan-library-catalogs (&optional message-base no-load) | 5643 | (defun idlwave-scan-library-catalogs (&optional message-base no-load) |
| 5644 | "Scan for library catalog files (.idlwave_catalog) and ingest. | 5644 | "Scan for library catalog files (.idlwave_catalog) and ingest. |
| 5645 | 5645 | ||
| 5646 | All directories on `idlwave-path-alist' (or `idlwave-library-path' | 5646 | All directories on `idlwave-path-alist' (or `idlwave-library-path' |
| 5647 | instead, if present) are searched. Print MESSAGE-BASE along with the | 5647 | instead, if present) are searched. Print MESSAGE-BASE along with the |
| @@ -5649,7 +5649,7 @@ libraries being loaded, if passed, and skip loading/normalizing if | |||
| 5649 | NO-LOAD is non-nil. The variable `idlwave-use-library-catalogs' can | 5649 | NO-LOAD is non-nil. The variable `idlwave-use-library-catalogs' can |
| 5650 | be set to nil to disable library catalog scanning." | 5650 | be set to nil to disable library catalog scanning." |
| 5651 | (when idlwave-use-library-catalogs | 5651 | (when idlwave-use-library-catalogs |
| 5652 | (let ((dirs | 5652 | (let ((dirs |
| 5653 | (if idlwave-library-path | 5653 | (if idlwave-library-path |
| 5654 | (idlwave-expand-path idlwave-library-path) | 5654 | (idlwave-expand-path idlwave-library-path) |
| 5655 | (mapcar 'car idlwave-path-alist))) | 5655 | (mapcar 'car idlwave-path-alist))) |
| @@ -5658,7 +5658,7 @@ be set to nil to disable library catalog scanning." | |||
| 5658 | (if message-base (message message-base)) | 5658 | (if message-base (message message-base)) |
| 5659 | (while (setq dir (pop dirs)) | 5659 | (while (setq dir (pop dirs)) |
| 5660 | (catch 'continue | 5660 | (catch 'continue |
| 5661 | (when (file-readable-p | 5661 | (when (file-readable-p |
| 5662 | (setq catalog (expand-file-name ".idlwave_catalog" dir))) | 5662 | (setq catalog (expand-file-name ".idlwave_catalog" dir))) |
| 5663 | (unless no-load | 5663 | (unless no-load |
| 5664 | (setq idlwave-library-catalog-routines nil) | 5664 | (setq idlwave-library-catalog-routines nil) |
| @@ -5666,20 +5666,20 @@ be set to nil to disable library catalog scanning." | |||
| 5666 | (condition-case nil | 5666 | (condition-case nil |
| 5667 | (load catalog t t t) | 5667 | (load catalog t t t) |
| 5668 | (error (throw 'continue t))) | 5668 | (error (throw 'continue t))) |
| 5669 | (when (and | 5669 | (when (and |
| 5670 | message-base | 5670 | message-base |
| 5671 | (not (string= idlwave-library-catalog-libname | 5671 | (not (string= idlwave-library-catalog-libname |
| 5672 | old-libname))) | 5672 | old-libname))) |
| 5673 | (message "%s" (concat message-base | 5673 | (message "%s" (concat message-base |
| 5674 | idlwave-library-catalog-libname)) | 5674 | idlwave-library-catalog-libname)) |
| 5675 | (setq old-libname idlwave-library-catalog-libname)) | 5675 | (setq old-libname idlwave-library-catalog-libname)) |
| 5676 | (when idlwave-library-catalog-routines | 5676 | (when idlwave-library-catalog-routines |
| 5677 | (setq all-routines | 5677 | (setq all-routines |
| 5678 | (append | 5678 | (append |
| 5679 | (idlwave-sintern-rinfo-list | 5679 | (idlwave-sintern-rinfo-list |
| 5680 | idlwave-library-catalog-routines 'sys dir) | 5680 | idlwave-library-catalog-routines 'sys dir) |
| 5681 | all-routines)))) | 5681 | all-routines)))) |
| 5682 | 5682 | ||
| 5683 | ;; Add a 'lib flag if on path-alist | 5683 | ;; Add a 'lib flag if on path-alist |
| 5684 | (when (and idlwave-path-alist | 5684 | (when (and idlwave-path-alist |
| 5685 | (setq dir-entry (assoc dir idlwave-path-alist))) | 5685 | (setq dir-entry (assoc dir idlwave-path-alist))) |
| @@ -5690,7 +5690,7 @@ be set to nil to disable library catalog scanning." | |||
| 5690 | ;;----- Communicating with the Shell ------------------- | 5690 | ;;----- Communicating with the Shell ------------------- |
| 5691 | 5691 | ||
| 5692 | ;; First, here is the idl program which can be used to query IDL for | 5692 | ;; First, here is the idl program which can be used to query IDL for |
| 5693 | ;; defined routines. | 5693 | ;; defined routines. |
| 5694 | (defconst idlwave-routine-info.pro | 5694 | (defconst idlwave-routine-info.pro |
| 5695 | " | 5695 | " |
| 5696 | ;; START OF IDLWAVE SUPPORT ROUTINES | 5696 | ;; START OF IDLWAVE SUPPORT ROUTINES |
| @@ -5708,10 +5708,10 @@ end | |||
| 5708 | pro idlwave_print_info_entry,name,func=func,separator=sep | 5708 | pro idlwave_print_info_entry,name,func=func,separator=sep |
| 5709 | ;; See if it's an object method | 5709 | ;; See if it's an object method |
| 5710 | if name eq '' then return | 5710 | if name eq '' then return |
| 5711 | func = keyword_set(func) | 5711 | func = keyword_set(func) |
| 5712 | methsep = strpos(name,'::') | 5712 | methsep = strpos(name,'::') |
| 5713 | meth = methsep ne -1 | 5713 | meth = methsep ne -1 |
| 5714 | 5714 | ||
| 5715 | ;; Get routine info | 5715 | ;; Get routine info |
| 5716 | pars = routine_info(name,/parameters,functions=func) | 5716 | pars = routine_info(name,/parameters,functions=func) |
| 5717 | source = routine_info(name,/source,functions=func) | 5717 | source = routine_info(name,/source,functions=func) |
| @@ -5719,12 +5719,12 @@ pro idlwave_print_info_entry,name,func=func,separator=sep | |||
| 5719 | nkw = pars.num_kw_args | 5719 | nkw = pars.num_kw_args |
| 5720 | if nargs gt 0 then args = pars.args | 5720 | if nargs gt 0 then args = pars.args |
| 5721 | if nkw gt 0 then kwargs = pars.kw_args | 5721 | if nkw gt 0 then kwargs = pars.kw_args |
| 5722 | 5722 | ||
| 5723 | ;; Trim the class, and make the name | 5723 | ;; Trim the class, and make the name |
| 5724 | if meth then begin | 5724 | if meth then begin |
| 5725 | class = strmid(name,0,methsep) | 5725 | class = strmid(name,0,methsep) |
| 5726 | name = strmid(name,methsep+2,strlen(name)-1) | 5726 | name = strmid(name,methsep+2,strlen(name)-1) |
| 5727 | if nargs gt 0 then begin | 5727 | if nargs gt 0 then begin |
| 5728 | ;; remove the self argument | 5728 | ;; remove the self argument |
| 5729 | wh = where(args ne 'SELF',nargs) | 5729 | wh = where(args ne 'SELF',nargs) |
| 5730 | if nargs gt 0 then args = args[wh] | 5730 | if nargs gt 0 then args = args[wh] |
| @@ -5733,7 +5733,7 @@ pro idlwave_print_info_entry,name,func=func,separator=sep | |||
| 5733 | ;; No class, just a normal routine. | 5733 | ;; No class, just a normal routine. |
| 5734 | class = \"\" | 5734 | class = \"\" |
| 5735 | endelse | 5735 | endelse |
| 5736 | 5736 | ||
| 5737 | ;; Calling sequence | 5737 | ;; Calling sequence |
| 5738 | cs = \"\" | 5738 | cs = \"\" |
| 5739 | if func then cs = 'Result = ' | 5739 | if func then cs = 'Result = ' |
| @@ -5754,9 +5754,9 @@ pro idlwave_print_info_entry,name,func=func,separator=sep | |||
| 5754 | kwstring = kwstring + ' ' + kwargs[j] | 5754 | kwstring = kwstring + ' ' + kwargs[j] |
| 5755 | endfor | 5755 | endfor |
| 5756 | endif | 5756 | endif |
| 5757 | 5757 | ||
| 5758 | ret=(['IDLWAVE-PRO','IDLWAVE-FUN'])[func] | 5758 | ret=(['IDLWAVE-PRO','IDLWAVE-FUN'])[func] |
| 5759 | 5759 | ||
| 5760 | print,ret + ': ' + name + sep + class + sep + source[0].path $ | 5760 | print,ret + ': ' + name + sep + class + sep + source[0].path $ |
| 5761 | + sep + cs + sep + kwstring | 5761 | + sep + cs + sep + kwstring |
| 5762 | end | 5762 | end |
| @@ -5768,19 +5768,19 @@ pro idlwave_routine_info,file | |||
| 5768 | all = routine_info() | 5768 | all = routine_info() |
| 5769 | fileQ=n_elements(file) ne 0 | 5769 | fileQ=n_elements(file) ne 0 |
| 5770 | if fileQ then file=strtrim(file,2) | 5770 | if fileQ then file=strtrim(file,2) |
| 5771 | for i=0L,n_elements(all)-1L do begin | 5771 | for i=0L,n_elements(all)-1L do begin |
| 5772 | if fileQ then begin | 5772 | if fileQ then begin |
| 5773 | if (routine_info(all[i],/SOURCE)).path eq file then $ | 5773 | if (routine_info(all[i],/SOURCE)).path eq file then $ |
| 5774 | idlwave_print_info_entry,all[i],separator=sep | 5774 | idlwave_print_info_entry,all[i],separator=sep |
| 5775 | endif else idlwave_print_info_entry,all[i],separator=sep | 5775 | endif else idlwave_print_info_entry,all[i],separator=sep |
| 5776 | endfor | 5776 | endfor |
| 5777 | all = routine_info(/functions) | 5777 | all = routine_info(/functions) |
| 5778 | for i=0L,n_elements(all)-1L do begin | 5778 | for i=0L,n_elements(all)-1L do begin |
| 5779 | if fileQ then begin | 5779 | if fileQ then begin |
| 5780 | if (routine_info(all[i],/FUNCTIONS,/SOURCE)).path eq file then $ | 5780 | if (routine_info(all[i],/FUNCTIONS,/SOURCE)).path eq file then $ |
| 5781 | idlwave_print_info_entry,all[i],separator=sep,/FUNC | 5781 | idlwave_print_info_entry,all[i],separator=sep,/FUNC |
| 5782 | endif else idlwave_print_info_entry,all[i],separator=sep,/FUNC | 5782 | endif else idlwave_print_info_entry,all[i],separator=sep,/FUNC |
| 5783 | endfor | 5783 | endfor |
| 5784 | print,'>>>END OF IDLWAVE ROUTINE INFO' | 5784 | print,'>>>END OF IDLWAVE ROUTINE INFO' |
| 5785 | end | 5785 | end |
| 5786 | 5786 | ||
| @@ -5806,7 +5806,7 @@ pro idlwave_get_class_tags, class | |||
| 5806 | if res then print,'IDLWAVE-CLASS-TAGS: '+class+' '+strjoin(tags,' ',/single) | 5806 | if res then print,'IDLWAVE-CLASS-TAGS: '+class+' '+strjoin(tags,' ',/single) |
| 5807 | end | 5807 | end |
| 5808 | ;; END OF IDLWAVE SUPPORT ROUTINES | 5808 | ;; END OF IDLWAVE SUPPORT ROUTINES |
| 5809 | " | 5809 | " |
| 5810 | "The idl programs to get info from the shell.") | 5810 | "The idl programs to get info from the shell.") |
| 5811 | 5811 | ||
| 5812 | (defvar idlwave-idlwave_routine_info-compiled nil | 5812 | (defvar idlwave-idlwave_routine_info-compiled nil |
| @@ -5824,11 +5824,11 @@ end | |||
| 5824 | (erase-buffer) | 5824 | (erase-buffer) |
| 5825 | (insert idlwave-routine-info.pro) | 5825 | (insert idlwave-routine-info.pro) |
| 5826 | (save-buffer 0)) | 5826 | (save-buffer 0)) |
| 5827 | (idlwave-shell-send-command | 5827 | (idlwave-shell-send-command |
| 5828 | (concat ".run \"" idlwave-shell-temp-pro-file "\"") | 5828 | (concat ".run \"" idlwave-shell-temp-pro-file "\"") |
| 5829 | nil 'hide wait) | 5829 | nil 'hide wait) |
| 5830 | (idlwave-shell-send-command | 5830 | (idlwave-shell-send-command |
| 5831 | (format "save,'idlwave_print_safe','idlwave_routine_info','idlwave_print_info_entry','idlwave_get_class_tags','idlwave_get_sysvars',FILE='%s',/ROUTINES" | 5831 | (format "save,'idlwave_print_safe','idlwave_routine_info','idlwave_print_info_entry','idlwave_get_class_tags','idlwave_get_sysvars',FILE='%s',/ROUTINES" |
| 5832 | (idlwave-shell-temp-file 'rinfo)) | 5832 | (idlwave-shell-temp-file 'rinfo)) |
| 5833 | nil 'hide) | 5833 | nil 'hide) |
| 5834 | (setq idlwave-idlwave_routine_info-compiled t)) | 5834 | (setq idlwave-idlwave_routine_info-compiled t)) |
| @@ -5929,7 +5929,7 @@ When we force a method or a method keyword, CLASS can specify the class." | |||
| 5929 | (completion-regexp-list | 5929 | (completion-regexp-list |
| 5930 | (if (equal arg '(16)) | 5930 | (if (equal arg '(16)) |
| 5931 | (list (read-string (concat "Completion Regexp: ")))))) | 5931 | (list (read-string (concat "Completion Regexp: ")))))) |
| 5932 | 5932 | ||
| 5933 | (if (and module (string-match "::" module)) | 5933 | (if (and module (string-match "::" module)) |
| 5934 | (setq class (substring module 0 (match-beginning 0)) | 5934 | (setq class (substring module 0 (match-beginning 0)) |
| 5935 | module (substring module (match-end 0)))) | 5935 | module (substring module (match-end 0)))) |
| @@ -5950,7 +5950,7 @@ When we force a method or a method keyword, CLASS can specify the class." | |||
| 5950 | ;; Check for any special completion functions | 5950 | ;; Check for any special completion functions |
| 5951 | ((and idlwave-complete-special | 5951 | ((and idlwave-complete-special |
| 5952 | (idlwave-call-special idlwave-complete-special))) | 5952 | (idlwave-call-special idlwave-complete-special))) |
| 5953 | 5953 | ||
| 5954 | ((null what) | 5954 | ((null what) |
| 5955 | (error "Nothing to complete here")) | 5955 | (error "Nothing to complete here")) |
| 5956 | 5956 | ||
| @@ -5967,7 +5967,7 @@ When we force a method or a method keyword, CLASS can specify the class." | |||
| 5967 | (idlwave-all-class-inherits class-selector))) | 5967 | (idlwave-all-class-inherits class-selector))) |
| 5968 | (isa (concat "procedure" (if class-selector "-method" ""))) | 5968 | (isa (concat "procedure" (if class-selector "-method" ""))) |
| 5969 | (type-selector 'pro)) | 5969 | (type-selector 'pro)) |
| 5970 | (setq idlwave-completion-help-info | 5970 | (setq idlwave-completion-help-info |
| 5971 | (list 'routine nil type-selector class-selector nil super-classes)) | 5971 | (list 'routine nil type-selector class-selector nil super-classes)) |
| 5972 | (idlwave-complete-in-buffer | 5972 | (idlwave-complete-in-buffer |
| 5973 | 'procedure (if class-selector 'method 'routine) | 5973 | 'procedure (if class-selector 'method 'routine) |
| @@ -5975,8 +5975,8 @@ When we force a method or a method keyword, CLASS can specify the class." | |||
| 5975 | (format "Select a %s name%s" | 5975 | (format "Select a %s name%s" |
| 5976 | isa | 5976 | isa |
| 5977 | (if class-selector | 5977 | (if class-selector |
| 5978 | (format " (class is %s)" | 5978 | (format " (class is %s)" |
| 5979 | (if (eq class-selector t) | 5979 | (if (eq class-selector t) |
| 5980 | "unknown" class-selector)) | 5980 | "unknown" class-selector)) |
| 5981 | "")) | 5981 | "")) |
| 5982 | isa | 5982 | isa |
| @@ -5990,7 +5990,7 @@ When we force a method or a method keyword, CLASS can specify the class." | |||
| 5990 | (idlwave-all-class-inherits class-selector))) | 5990 | (idlwave-all-class-inherits class-selector))) |
| 5991 | (isa (concat "function" (if class-selector "-method" ""))) | 5991 | (isa (concat "function" (if class-selector "-method" ""))) |
| 5992 | (type-selector 'fun)) | 5992 | (type-selector 'fun)) |
| 5993 | (setq idlwave-completion-help-info | 5993 | (setq idlwave-completion-help-info |
| 5994 | (list 'routine nil type-selector class-selector nil super-classes)) | 5994 | (list 'routine nil type-selector class-selector nil super-classes)) |
| 5995 | (idlwave-complete-in-buffer | 5995 | (idlwave-complete-in-buffer |
| 5996 | 'function (if class-selector 'method 'routine) | 5996 | 'function (if class-selector 'method 'routine) |
| @@ -5998,7 +5998,7 @@ When we force a method or a method keyword, CLASS can specify the class." | |||
| 5998 | (format "Select a %s name%s" | 5998 | (format "Select a %s name%s" |
| 5999 | isa | 5999 | isa |
| 6000 | (if class-selector | 6000 | (if class-selector |
| 6001 | (format " (class is %s)" | 6001 | (format " (class is %s)" |
| 6002 | (if (eq class-selector t) | 6002 | (if (eq class-selector t) |
| 6003 | "unknown" class-selector)) | 6003 | "unknown" class-selector)) |
| 6004 | "")) | 6004 | "")) |
| @@ -6026,18 +6026,18 @@ When we force a method or a method keyword, CLASS can specify the class." | |||
| 6026 | (unless (or entry (eq class t)) | 6026 | (unless (or entry (eq class t)) |
| 6027 | (error "Nothing known about procedure %s" | 6027 | (error "Nothing known about procedure %s" |
| 6028 | (idlwave-make-full-name class name))) | 6028 | (idlwave-make-full-name class name))) |
| 6029 | (setq list (idlwave-fix-keywords name 'pro class list | 6029 | (setq list (idlwave-fix-keywords name 'pro class list |
| 6030 | super-classes system)) | 6030 | super-classes system)) |
| 6031 | (unless list (error "No keywords available for procedure %s" | 6031 | (unless list (error "No keywords available for procedure %s" |
| 6032 | (idlwave-make-full-name class name))) | 6032 | (idlwave-make-full-name class name))) |
| 6033 | (setq idlwave-completion-help-info | 6033 | (setq idlwave-completion-help-info |
| 6034 | (list 'keyword name type-selector class-selector entry super-classes)) | 6034 | (list 'keyword name type-selector class-selector entry super-classes)) |
| 6035 | (idlwave-complete-in-buffer | 6035 | (idlwave-complete-in-buffer |
| 6036 | 'keyword 'keyword list nil | 6036 | 'keyword 'keyword list nil |
| 6037 | (format "Select keyword for procedure %s%s" | 6037 | (format "Select keyword for procedure %s%s" |
| 6038 | (idlwave-make-full-name class name) | 6038 | (idlwave-make-full-name class name) |
| 6039 | (if (or (member '("_EXTRA") list) | 6039 | (if (or (member '("_EXTRA") list) |
| 6040 | (member '("_REF_EXTRA") list)) | 6040 | (member '("_REF_EXTRA") list)) |
| 6041 | " (note _EXTRA)" "")) | 6041 | " (note _EXTRA)" "")) |
| 6042 | isa | 6042 | isa |
| 6043 | 'idlwave-attach-keyword-classes))) | 6043 | 'idlwave-attach-keyword-classes))) |
| @@ -6060,7 +6060,7 @@ When we force a method or a method keyword, CLASS can specify the class." | |||
| 6060 | (unless (or entry (eq class t)) | 6060 | (unless (or entry (eq class t)) |
| 6061 | (error "Nothing known about function %s" | 6061 | (error "Nothing known about function %s" |
| 6062 | (idlwave-make-full-name class name))) | 6062 | (idlwave-make-full-name class name))) |
| 6063 | (setq list (idlwave-fix-keywords name 'fun class list | 6063 | (setq list (idlwave-fix-keywords name 'fun class list |
| 6064 | super-classes system)) | 6064 | super-classes system)) |
| 6065 | ;; OBJ_NEW: Messages mention the proper Init method | 6065 | ;; OBJ_NEW: Messages mention the proper Init method |
| 6066 | (setq msg-name (if (and (null class) | 6066 | (setq msg-name (if (and (null class) |
| @@ -6070,13 +6070,13 @@ When we force a method or a method keyword, CLASS can specify the class." | |||
| 6070 | (idlwave-make-full-name class name))) | 6070 | (idlwave-make-full-name class name))) |
| 6071 | (unless list (error "No keywords available for function %s" | 6071 | (unless list (error "No keywords available for function %s" |
| 6072 | msg-name)) | 6072 | msg-name)) |
| 6073 | (setq idlwave-completion-help-info | 6073 | (setq idlwave-completion-help-info |
| 6074 | (list 'keyword name type-selector class-selector nil super-classes)) | 6074 | (list 'keyword name type-selector class-selector nil super-classes)) |
| 6075 | (idlwave-complete-in-buffer | 6075 | (idlwave-complete-in-buffer |
| 6076 | 'keyword 'keyword list nil | 6076 | 'keyword 'keyword list nil |
| 6077 | (format "Select keyword for function %s%s" msg-name | 6077 | (format "Select keyword for function %s%s" msg-name |
| 6078 | (if (or (member '("_EXTRA") list) | 6078 | (if (or (member '("_EXTRA") list) |
| 6079 | (member '("_REF_EXTRA") list)) | 6079 | (member '("_REF_EXTRA") list)) |
| 6080 | " (note _EXTRA)" "")) | 6080 | " (note _EXTRA)" "")) |
| 6081 | isa | 6081 | isa |
| 6082 | 'idlwave-attach-keyword-classes))) | 6082 | 'idlwave-attach-keyword-classes))) |
| @@ -6114,10 +6114,10 @@ other completions will be tried.") | |||
| 6114 | ("class"))) | 6114 | ("class"))) |
| 6115 | (module (idlwave-sintern-routine-or-method module class)) | 6115 | (module (idlwave-sintern-routine-or-method module class)) |
| 6116 | (class (idlwave-sintern-class class)) | 6116 | (class (idlwave-sintern-class class)) |
| 6117 | (what (cond | 6117 | (what (cond |
| 6118 | ((equal what 0) | 6118 | ((equal what 0) |
| 6119 | (setq what | 6119 | (setq what |
| 6120 | (intern (completing-read | 6120 | (intern (completing-read |
| 6121 | "Complete what? " what-list nil t)))) | 6121 | "Complete what? " what-list nil t)))) |
| 6122 | ((integerp what) | 6122 | ((integerp what) |
| 6123 | (setq what (intern (car (nth (1- what) what-list))))) | 6123 | (setq what (intern (car (nth (1- what) what-list))))) |
| @@ -6139,7 +6139,7 @@ other completions will be tried.") | |||
| 6139 | (super-classes nil) | 6139 | (super-classes nil) |
| 6140 | (type-selector 'pro) | 6140 | (type-selector 'pro) |
| 6141 | (pro (or module | 6141 | (pro (or module |
| 6142 | (idlwave-completing-read | 6142 | (idlwave-completing-read |
| 6143 | "Procedure: " (idlwave-routines) 'idlwave-selector)))) | 6143 | "Procedure: " (idlwave-routines) 'idlwave-selector)))) |
| 6144 | (setq pro (idlwave-sintern-routine pro)) | 6144 | (setq pro (idlwave-sintern-routine pro)) |
| 6145 | (list nil-list nil-list 'procedure-keyword | 6145 | (list nil-list nil-list 'procedure-keyword |
| @@ -6153,7 +6153,7 @@ other completions will be tried.") | |||
| 6153 | (super-classes nil) | 6153 | (super-classes nil) |
| 6154 | (type-selector 'fun) | 6154 | (type-selector 'fun) |
| 6155 | (func (or module | 6155 | (func (or module |
| 6156 | (idlwave-completing-read | 6156 | (idlwave-completing-read |
| 6157 | "Function: " (idlwave-routines) 'idlwave-selector)))) | 6157 | "Function: " (idlwave-routines) 'idlwave-selector)))) |
| 6158 | (setq func (idlwave-sintern-routine func)) | 6158 | (setq func (idlwave-sintern-routine func)) |
| 6159 | (list nil-list nil-list 'function-keyword | 6159 | (list nil-list nil-list 'function-keyword |
| @@ -6193,7 +6193,7 @@ other completions will be tried.") | |||
| 6193 | 6193 | ||
| 6194 | ((eq what 'class) | 6194 | ((eq what 'class) |
| 6195 | (list nil-list nil-list 'class nil-list nil)) | 6195 | (list nil-list nil-list 'class nil-list nil)) |
| 6196 | 6196 | ||
| 6197 | (t (error "Invalid value for WHAT"))))) | 6197 | (t (error "Invalid value for WHAT"))))) |
| 6198 | 6198 | ||
| 6199 | (defun idlwave-completing-read (&rest args) | 6199 | (defun idlwave-completing-read (&rest args) |
| @@ -6216,7 +6216,7 @@ other completions will be tried.") | |||
| 6216 | (stringp idlwave-shell-default-directory) | 6216 | (stringp idlwave-shell-default-directory) |
| 6217 | (file-directory-p idlwave-shell-default-directory)) | 6217 | (file-directory-p idlwave-shell-default-directory)) |
| 6218 | idlwave-shell-default-directory | 6218 | idlwave-shell-default-directory |
| 6219 | default-directory))) | 6219 | default-directory))) |
| 6220 | (comint-dynamic-complete-filename))) | 6220 | (comint-dynamic-complete-filename))) |
| 6221 | 6221 | ||
| 6222 | (defun idlwave-make-full-name (class name) | 6222 | (defun idlwave-make-full-name (class name) |
| @@ -6225,7 +6225,7 @@ other completions will be tried.") | |||
| 6225 | 6225 | ||
| 6226 | (defun idlwave-rinfo-assoc (name type class list) | 6226 | (defun idlwave-rinfo-assoc (name type class list) |
| 6227 | "Like `idlwave-rinfo-assq', but sintern strings first." | 6227 | "Like `idlwave-rinfo-assq', but sintern strings first." |
| 6228 | (idlwave-rinfo-assq | 6228 | (idlwave-rinfo-assq |
| 6229 | (idlwave-sintern-routine-or-method name class) | 6229 | (idlwave-sintern-routine-or-method name class) |
| 6230 | type (idlwave-sintern-class class) list)) | 6230 | type (idlwave-sintern-class class) list)) |
| 6231 | 6231 | ||
| @@ -6249,7 +6249,7 @@ other completions will be tried.") | |||
| 6249 | (setq classes nil))) | 6249 | (setq classes nil))) |
| 6250 | rtn)) | 6250 | rtn)) |
| 6251 | 6251 | ||
| 6252 | (defun idlwave-best-rinfo-assq (name type class list &optional with-file | 6252 | (defun idlwave-best-rinfo-assq (name type class list &optional with-file |
| 6253 | keep-system) | 6253 | keep-system) |
| 6254 | "Like `idlwave-rinfo-assq', but get all twins and sort, then return first. | 6254 | "Like `idlwave-rinfo-assq', but get all twins and sort, then return first. |
| 6255 | If WITH-FILE is passed, find the best rinfo entry with a file | 6255 | If WITH-FILE is passed, find the best rinfo entry with a file |
| @@ -6274,7 +6274,7 @@ syslib files." | |||
| 6274 | twins))))) | 6274 | twins))))) |
| 6275 | (car twins))) | 6275 | (car twins))) |
| 6276 | 6276 | ||
| 6277 | (defun idlwave-best-rinfo-assoc (name type class list &optional with-file | 6277 | (defun idlwave-best-rinfo-assoc (name type class list &optional with-file |
| 6278 | keep-system) | 6278 | keep-system) |
| 6279 | "Like `idlwave-best-rinfo-assq', but sintern strings first." | 6279 | "Like `idlwave-best-rinfo-assq', but sintern strings first." |
| 6280 | (idlwave-best-rinfo-assq | 6280 | (idlwave-best-rinfo-assq |
| @@ -6365,7 +6365,7 @@ INFO is as returned by idlwave-what-function or -procedure." | |||
| 6365 | Must accept two arguments: `apos' and `info'") | 6365 | Must accept two arguments: `apos' and `info'") |
| 6366 | 6366 | ||
| 6367 | (defun idlwave-determine-class (info type) | 6367 | (defun idlwave-determine-class (info type) |
| 6368 | ;; Determine the class of a routine call. | 6368 | ;; Determine the class of a routine call. |
| 6369 | ;; INFO is the `cw-list' structure as returned by idlwave-where. | 6369 | ;; INFO is the `cw-list' structure as returned by idlwave-where. |
| 6370 | ;; The second element in this structure is the class. When nil, we | 6370 | ;; The second element in this structure is the class. When nil, we |
| 6371 | ;; return nil. When t, try to get the class from text properties at | 6371 | ;; return nil. When t, try to get the class from text properties at |
| @@ -6385,7 +6385,7 @@ Must accept two arguments: `apos' and `info'") | |||
| 6385 | (dassoc (cdr dassoc)) | 6385 | (dassoc (cdr dassoc)) |
| 6386 | (t t))) | 6386 | (t t))) |
| 6387 | (arrow (and apos (string= (buffer-substring apos (+ 2 apos)) "->"))) | 6387 | (arrow (and apos (string= (buffer-substring apos (+ 2 apos)) "->"))) |
| 6388 | (is-self | 6388 | (is-self |
| 6389 | (and arrow | 6389 | (and arrow |
| 6390 | (save-excursion (goto-char apos) | 6390 | (save-excursion (goto-char apos) |
| 6391 | (forward-word -1) | 6391 | (forward-word -1) |
| @@ -6406,19 +6406,19 @@ Must accept two arguments: `apos' and `info'") | |||
| 6406 | (setq class (or (nth 2 (idlwave-current-routine)) class))) | 6406 | (setq class (or (nth 2 (idlwave-current-routine)) class))) |
| 6407 | 6407 | ||
| 6408 | ;; Before prompting, try any special class determination routines | 6408 | ;; Before prompting, try any special class determination routines |
| 6409 | (when (and (eq t class) | 6409 | (when (and (eq t class) |
| 6410 | idlwave-determine-class-special | 6410 | idlwave-determine-class-special |
| 6411 | (not force-query)) | 6411 | (not force-query)) |
| 6412 | (setq special-class | 6412 | (setq special-class |
| 6413 | (idlwave-call-special idlwave-determine-class-special apos)) | 6413 | (idlwave-call-special idlwave-determine-class-special apos)) |
| 6414 | (if special-class | 6414 | (if special-class |
| 6415 | (setq class (idlwave-sintern-class special-class) | 6415 | (setq class (idlwave-sintern-class special-class) |
| 6416 | store idlwave-store-inquired-class))) | 6416 | store idlwave-store-inquired-class))) |
| 6417 | 6417 | ||
| 6418 | ;; Prompt for a class, if we need to | 6418 | ;; Prompt for a class, if we need to |
| 6419 | (when (and (eq class t) | 6419 | (when (and (eq class t) |
| 6420 | (or force-query query)) | 6420 | (or force-query query)) |
| 6421 | (setq class-alist | 6421 | (setq class-alist |
| 6422 | (mapcar 'list (idlwave-all-method-classes (car info) type))) | 6422 | (mapcar 'list (idlwave-all-method-classes (car info) type))) |
| 6423 | (setq class | 6423 | (setq class |
| 6424 | (idlwave-sintern-class | 6424 | (idlwave-sintern-class |
| @@ -6427,9 +6427,9 @@ Must accept two arguments: `apos' and `info'") | |||
| 6427 | (error "No classes available with method %s" (car info))) | 6427 | (error "No classes available with method %s" (car info))) |
| 6428 | ((and (= (length class-alist) 1) (not force-query)) | 6428 | ((and (= (length class-alist) 1) (not force-query)) |
| 6429 | (car (car class-alist))) | 6429 | (car (car class-alist))) |
| 6430 | (t | 6430 | (t |
| 6431 | (setq store idlwave-store-inquired-class) | 6431 | (setq store idlwave-store-inquired-class) |
| 6432 | (idlwave-completing-read | 6432 | (idlwave-completing-read |
| 6433 | (format "Class%s: " (if (stringp (car info)) | 6433 | (format "Class%s: " (if (stringp (car info)) |
| 6434 | (format " for %s method %s" | 6434 | (format " for %s method %s" |
| 6435 | type (car info)) | 6435 | type (car info)) |
| @@ -6441,9 +6441,9 @@ Must accept two arguments: `apos' and `info'") | |||
| 6441 | ;; We have a real class here | 6441 | ;; We have a real class here |
| 6442 | (when (and store arrow) | 6442 | (when (and store arrow) |
| 6443 | (condition-case () | 6443 | (condition-case () |
| 6444 | (add-text-properties | 6444 | (add-text-properties |
| 6445 | apos (+ apos 2) | 6445 | apos (+ apos 2) |
| 6446 | `(idlwave-class ,class face ,idlwave-class-arrow-face | 6446 | `(idlwave-class ,class face ,idlwave-class-arrow-face |
| 6447 | rear-nonsticky t)) | 6447 | rear-nonsticky t)) |
| 6448 | (error nil))) | 6448 | (error nil))) |
| 6449 | (setf (nth 2 info) class)) | 6449 | (setf (nth 2 info) class)) |
| @@ -6471,14 +6471,14 @@ Must accept two arguments: `apos' and `info'") | |||
| 6471 | 6471 | ||
| 6472 | 6472 | ||
| 6473 | (defun idlwave-where () | 6473 | (defun idlwave-where () |
| 6474 | "Find out where we are. | 6474 | "Find out where we are. |
| 6475 | The return value is a list with the following stuff: | 6475 | The return value is a list with the following stuff: |
| 6476 | \(PRO-LIST FUNC-LIST COMPLETE-WHAT CW-LIST LAST-CHAR) | 6476 | \(PRO-LIST FUNC-LIST COMPLETE-WHAT CW-LIST LAST-CHAR) |
| 6477 | 6477 | ||
| 6478 | PRO-LIST (PRO POINT CLASS ARROW) | 6478 | PRO-LIST (PRO POINT CLASS ARROW) |
| 6479 | FUNC-LIST (FUNC POINT CLASS ARROW) | 6479 | FUNC-LIST (FUNC POINT CLASS ARROW) |
| 6480 | COMPLETE-WHAT a symbol indicating what kind of completion makes sense here | 6480 | COMPLETE-WHAT a symbol indicating what kind of completion makes sense here |
| 6481 | CW-LIST (PRO-OR-FUNC POINT CLASS ARROW) Like PRO-LIST, for what can | 6481 | CW-LIST (PRO-OR-FUNC POINT CLASS ARROW) Like PRO-LIST, for what can |
| 6482 | be completed here. | 6482 | be completed here. |
| 6483 | LAST-CHAR last relevant character before point (non-white non-comment, | 6483 | LAST-CHAR last relevant character before point (non-white non-comment, |
| 6484 | not part of current identifier or leading slash). | 6484 | not part of current identifier or leading slash). |
| @@ -6490,7 +6490,7 @@ POINT: Where is this | |||
| 6490 | CLASS: What class has the routine (nil=no, t=is method, but class unknown) | 6490 | CLASS: What class has the routine (nil=no, t=is method, but class unknown) |
| 6491 | ARROW: Location of the arrow" | 6491 | ARROW: Location of the arrow" |
| 6492 | (idlwave-routines) | 6492 | (idlwave-routines) |
| 6493 | (let* (;(bos (save-excursion (idlwave-beginning-of-statement) (point))) | 6493 | (let* (;(bos (save-excursion (idlwave-beginning-of-statement) (point))) |
| 6494 | (bos (save-excursion (idlwave-start-of-substatement 'pre) (point))) | 6494 | (bos (save-excursion (idlwave-start-of-substatement 'pre) (point))) |
| 6495 | (func-entry (idlwave-what-function bos)) | 6495 | (func-entry (idlwave-what-function bos)) |
| 6496 | (func (car func-entry)) | 6496 | (func (car func-entry)) |
| @@ -6512,8 +6512,8 @@ ARROW: Location of the arrow" | |||
| 6512 | ((string-match "\\`[ \t]*\\(pro\\|function\\)[ \t]+[a-zA-Z0-9_]*\\'" | 6512 | ((string-match "\\`[ \t]*\\(pro\\|function\\)[ \t]+[a-zA-Z0-9_]*\\'" |
| 6513 | match-string) | 6513 | match-string) |
| 6514 | (setq cw 'class)) | 6514 | (setq cw 'class)) |
| 6515 | ((string-match | 6515 | ((string-match |
| 6516 | "\\`[ \t]*\\([a-zA-Z][a-zA-Z0-9$_]*\\)?\\'" | 6516 | "\\`[ \t]*\\([a-zA-Z][a-zA-Z0-9$_]*\\)?\\'" |
| 6517 | (if (> pro-point 0) | 6517 | (if (> pro-point 0) |
| 6518 | (buffer-substring pro-point (point)) | 6518 | (buffer-substring pro-point (point)) |
| 6519 | match-string)) | 6519 | match-string)) |
| @@ -6524,11 +6524,11 @@ ARROW: Location of the arrow" | |||
| 6524 | nil) | 6524 | nil) |
| 6525 | ((string-match "OBJ_NEW([ \t]*['\"]\\([a-zA-Z0-9$_]*\\)?\\'" | 6525 | ((string-match "OBJ_NEW([ \t]*['\"]\\([a-zA-Z0-9$_]*\\)?\\'" |
| 6526 | match-string) | 6526 | match-string) |
| 6527 | (setq cw 'class)) | 6527 | (setq cw 'class)) |
| 6528 | ((string-match "\\<inherits\\s-+\\([a-zA-Z0-9$_]*\\)?\\'" | 6528 | ((string-match "\\<inherits\\s-+\\([a-zA-Z0-9$_]*\\)?\\'" |
| 6529 | match-string) | 6529 | match-string) |
| 6530 | (setq cw 'class)) | 6530 | (setq cw 'class)) |
| 6531 | ((and func | 6531 | ((and func |
| 6532 | (> func-point pro-point) | 6532 | (> func-point pro-point) |
| 6533 | (= func-level 1) | 6533 | (= func-level 1) |
| 6534 | (memq last-char '(?\( ?,))) | 6534 | (memq last-char '(?\( ?,))) |
| @@ -6574,7 +6574,7 @@ ARROW: Location of the arrow" | |||
| 6574 | ;; searches to this point. | 6574 | ;; searches to this point. |
| 6575 | 6575 | ||
| 6576 | (catch 'exit | 6576 | (catch 'exit |
| 6577 | (let (pos | 6577 | (let (pos |
| 6578 | func-point | 6578 | func-point |
| 6579 | (cnt 0) | 6579 | (cnt 0) |
| 6580 | func arrow-start class) | 6580 | func arrow-start class) |
| @@ -6589,18 +6589,18 @@ ARROW: Location of the arrow" | |||
| 6589 | (setq pos (point)) | 6589 | (setq pos (point)) |
| 6590 | (incf cnt) | 6590 | (incf cnt) |
| 6591 | (when (and (= (following-char) ?\() | 6591 | (when (and (= (following-char) ?\() |
| 6592 | (re-search-backward | 6592 | (re-search-backward |
| 6593 | "\\(::\\|\\<\\)\\([a-zA-Z][a-zA-Z0-9$_]*\\)[ \t]*\\=" | 6593 | "\\(::\\|\\<\\)\\([a-zA-Z][a-zA-Z0-9$_]*\\)[ \t]*\\=" |
| 6594 | bound t)) | 6594 | bound t)) |
| 6595 | (setq func (match-string 2) | 6595 | (setq func (match-string 2) |
| 6596 | func-point (goto-char (match-beginning 2)) | 6596 | func-point (goto-char (match-beginning 2)) |
| 6597 | pos func-point) | 6597 | pos func-point) |
| 6598 | (if (re-search-backward | 6598 | (if (re-search-backward |
| 6599 | "->[ \t]*\\(\\([a-zA-Z][a-zA-Z0-9$_]*\\)::\\)?\\=" bound t) | 6599 | "->[ \t]*\\(\\([a-zA-Z][a-zA-Z0-9$_]*\\)::\\)?\\=" bound t) |
| 6600 | (setq arrow-start (copy-marker (match-beginning 0)) | 6600 | (setq arrow-start (copy-marker (match-beginning 0)) |
| 6601 | class (or (match-string 2) t))) | 6601 | class (or (match-string 2) t))) |
| 6602 | (throw | 6602 | (throw |
| 6603 | 'exit | 6603 | 'exit |
| 6604 | (list | 6604 | (list |
| 6605 | (idlwave-sintern-routine-or-method func class) | 6605 | (idlwave-sintern-routine-or-method func class) |
| 6606 | (idlwave-sintern-class class) | 6606 | (idlwave-sintern-class class) |
| @@ -6616,18 +6616,18 @@ ARROW: Location of the arrow" | |||
| 6616 | ;; searches to this point. | 6616 | ;; searches to this point. |
| 6617 | (let ((pos (point)) pro-point | 6617 | (let ((pos (point)) pro-point |
| 6618 | pro class arrow-start string) | 6618 | pro class arrow-start string) |
| 6619 | (save-excursion | 6619 | (save-excursion |
| 6620 | ;;(idlwave-beginning-of-statement) | 6620 | ;;(idlwave-beginning-of-statement) |
| 6621 | (idlwave-start-of-substatement 'pre) | 6621 | (idlwave-start-of-substatement 'pre) |
| 6622 | (setq string (buffer-substring (point) pos)) | 6622 | (setq string (buffer-substring (point) pos)) |
| 6623 | (if (string-match | 6623 | (if (string-match |
| 6624 | "\\`[ \t]*\\([a-zA-Z][a-zA-Z0-9$_]*\\)[ \t]*\\(,\\|\\'\\)" string) | 6624 | "\\`[ \t]*\\([a-zA-Z][a-zA-Z0-9$_]*\\)[ \t]*\\(,\\|\\'\\)" string) |
| 6625 | (setq pro (match-string 1 string) | 6625 | (setq pro (match-string 1 string) |
| 6626 | pro-point (+ (point) (match-beginning 1))) | 6626 | pro-point (+ (point) (match-beginning 1))) |
| 6627 | (if (and (idlwave-skip-object) | 6627 | (if (and (idlwave-skip-object) |
| 6628 | (setq string (buffer-substring (point) pos)) | 6628 | (setq string (buffer-substring (point) pos)) |
| 6629 | (string-match | 6629 | (string-match |
| 6630 | "\\`[ \t]*\\(->\\)[ \t]*\\(\\([a-zA-Z][a-zA-Z0-9$_]*\\)::\\)?\\([a-zA-Z][a-zA-Z0-9$_]*\\)?[ \t]*\\(,\\|\\(\\$\\s *\\(;.*\\)?\\)?$\\)" | 6630 | "\\`[ \t]*\\(->\\)[ \t]*\\(\\([a-zA-Z][a-zA-Z0-9$_]*\\)::\\)?\\([a-zA-Z][a-zA-Z0-9$_]*\\)?[ \t]*\\(,\\|\\(\\$\\s *\\(;.*\\)?\\)?$\\)" |
| 6631 | string)) | 6631 | string)) |
| 6632 | (setq pro (if (match-beginning 4) | 6632 | (setq pro (if (match-beginning 4) |
| 6633 | (match-string 4 string)) | 6633 | (match-string 4 string)) |
| @@ -6671,7 +6671,7 @@ ARROW: Location of the arrow" | |||
| 6671 | (throw 'exit nil)))) | 6671 | (throw 'exit nil)))) |
| 6672 | (goto-char pos) | 6672 | (goto-char pos) |
| 6673 | nil))) | 6673 | nil))) |
| 6674 | 6674 | ||
| 6675 | (defun idlwave-last-valid-char () | 6675 | (defun idlwave-last-valid-char () |
| 6676 | "Return the last character before point which is not white or a comment | 6676 | "Return the last character before point which is not white or a comment |
| 6677 | and also not part of the current identifier. Since we do this in | 6677 | and also not part of the current identifier. Since we do this in |
| @@ -6761,23 +6761,23 @@ accumulate information on matching completions." | |||
| 6761 | ((or (eq completion t) | 6761 | ((or (eq completion t) |
| 6762 | (and (= 1 (length (setq all-completions | 6762 | (and (= 1 (length (setq all-completions |
| 6763 | (idlwave-uniquify | 6763 | (idlwave-uniquify |
| 6764 | (all-completions part list | 6764 | (all-completions part list |
| 6765 | (or special-selector | 6765 | (or special-selector |
| 6766 | selector)))))) | 6766 | selector)))))) |
| 6767 | (equal dpart dcompletion))) | 6767 | (equal dpart dcompletion))) |
| 6768 | ;; This is already complete | 6768 | ;; This is already complete |
| 6769 | (idlwave-after-successful-completion type slash beg) | 6769 | (idlwave-after-successful-completion type slash beg) |
| 6770 | (message "%s is already the complete %s" part isa) | 6770 | (message "%s is already the complete %s" part isa) |
| 6771 | nil) | 6771 | nil) |
| 6772 | (t | 6772 | (t |
| 6773 | ;; We cannot add something - offer a list. | 6773 | ;; We cannot add something - offer a list. |
| 6774 | (message "Making completion list...") | 6774 | (message "Making completion list...") |
| 6775 | 6775 | ||
| 6776 | (unless idlwave-completion-help-links ; already set somewhere? | 6776 | (unless idlwave-completion-help-links ; already set somewhere? |
| 6777 | (mapcar (lambda (x) ; Pass link prop through to highlight-linked | 6777 | (mapcar (lambda (x) ; Pass link prop through to highlight-linked |
| 6778 | (let ((link (get-text-property 0 'link (car x)))) | 6778 | (let ((link (get-text-property 0 'link (car x)))) |
| 6779 | (if link | 6779 | (if link |
| 6780 | (push (cons (car x) link) | 6780 | (push (cons (car x) link) |
| 6781 | idlwave-completion-help-links)))) | 6781 | idlwave-completion-help-links)))) |
| 6782 | list)) | 6782 | list)) |
| 6783 | (let* ((list all-completions) | 6783 | (let* ((list all-completions) |
| @@ -6787,7 +6787,7 @@ accumulate information on matching completions." | |||
| 6787 | ; (completion-fixup-function ; Emacs | 6787 | ; (completion-fixup-function ; Emacs |
| 6788 | ; (lambda () (and (eq (preceding-char) ?>) | 6788 | ; (lambda () (and (eq (preceding-char) ?>) |
| 6789 | ; (re-search-backward " <" beg t))))) | 6789 | ; (re-search-backward " <" beg t))))) |
| 6790 | 6790 | ||
| 6791 | (setq list (sort list (lambda (a b) | 6791 | (setq list (sort list (lambda (a b) |
| 6792 | (string< (downcase a) (downcase b))))) | 6792 | (string< (downcase a) (downcase b))))) |
| 6793 | (if prepare-display-function | 6793 | (if prepare-display-function |
| @@ -6797,7 +6797,7 @@ accumulate information on matching completions." | |||
| 6797 | idlwave-complete-empty-string-as-lower-case) | 6797 | idlwave-complete-empty-string-as-lower-case) |
| 6798 | (not idlwave-completion-force-default-case)) | 6798 | (not idlwave-completion-force-default-case)) |
| 6799 | (setq list (mapcar (lambda (x) | 6799 | (setq list (mapcar (lambda (x) |
| 6800 | (if (listp x) | 6800 | (if (listp x) |
| 6801 | (setcar x (downcase (car x))) | 6801 | (setcar x (downcase (car x))) |
| 6802 | (setq x (downcase x))) | 6802 | (setq x (downcase x))) |
| 6803 | x) | 6803 | x) |
| @@ -6817,19 +6817,19 @@ accumulate information on matching completions." | |||
| 6817 | (re-search-backward "\\<\\(pro\\|function\\)[ \t]+\\=" | 6817 | (re-search-backward "\\<\\(pro\\|function\\)[ \t]+\\=" |
| 6818 | (- (point) 15) t) | 6818 | (- (point) 15) t) |
| 6819 | (goto-char (point-min)) | 6819 | (goto-char (point-min)) |
| 6820 | (re-search-forward | 6820 | (re-search-forward |
| 6821 | "^[ \t]*\\(pro\\|function\\)[ \t]+\\([a-zA-Z0-9_]+::\\)" nil t)))) | 6821 | "^[ \t]*\\(pro\\|function\\)[ \t]+\\([a-zA-Z0-9_]+::\\)" nil t)))) |
| 6822 | ;; Yank the full class specification | 6822 | ;; Yank the full class specification |
| 6823 | (insert (match-string 2)) | 6823 | (insert (match-string 2)) |
| 6824 | ;; Do the completion, using list gathered from `idlwave-routines' | 6824 | ;; Do the completion, using list gathered from `idlwave-routines' |
| 6825 | (idlwave-complete-in-buffer | 6825 | (idlwave-complete-in-buffer |
| 6826 | 'class 'class (idlwave-class-alist) nil | 6826 | 'class 'class (idlwave-class-alist) nil |
| 6827 | "Select a class" "class" | 6827 | "Select a class" "class" |
| 6828 | '(lambda (list) ;; Push it to help-links if system help available | 6828 | '(lambda (list) ;; Push it to help-links if system help available |
| 6829 | (mapcar (lambda (x) | 6829 | (mapcar (lambda (x) |
| 6830 | (let* ((entry (idlwave-class-info x)) | 6830 | (let* ((entry (idlwave-class-info x)) |
| 6831 | (link (nth 1 (assq 'link entry)))) | 6831 | (link (nth 1 (assq 'link entry)))) |
| 6832 | (if link (push (cons x link) | 6832 | (if link (push (cons x link) |
| 6833 | idlwave-completion-help-links)) | 6833 | idlwave-completion-help-links)) |
| 6834 | x)) | 6834 | x)) |
| 6835 | list))))) | 6835 | list))))) |
| @@ -6841,7 +6841,7 @@ accumulate information on matching completions." | |||
| 6841 | ;; SHOW-CLASSES is the value of `idlwave-completion-show-classes'. | 6841 | ;; SHOW-CLASSES is the value of `idlwave-completion-show-classes'. |
| 6842 | (if (or (null show-classes) ; don't want to see classes | 6842 | (if (or (null show-classes) ; don't want to see classes |
| 6843 | (null class-selector) ; not a method call | 6843 | (null class-selector) ; not a method call |
| 6844 | (and | 6844 | (and |
| 6845 | (stringp class-selector) ; the class is already known | 6845 | (stringp class-selector) ; the class is already known |
| 6846 | (not super-classes))) ; no possibilities for inheritance | 6846 | (not super-classes))) ; no possibilities for inheritance |
| 6847 | ;; In these cases, we do not have to do anything | 6847 | ;; In these cases, we do not have to do anything |
| @@ -6856,13 +6856,13 @@ accumulate information on matching completions." | |||
| 6856 | (max (abs show-classes)) | 6856 | (max (abs show-classes)) |
| 6857 | (lmax (if do-dots (apply 'max (mapcar 'length list)))) | 6857 | (lmax (if do-dots (apply 'max (mapcar 'length list)))) |
| 6858 | classes nclasses class-info space) | 6858 | classes nclasses class-info space) |
| 6859 | (mapcar | 6859 | (mapcar |
| 6860 | (lambda (x) | 6860 | (lambda (x) |
| 6861 | ;; get the classes | 6861 | ;; get the classes |
| 6862 | (if (eq type 'class-tag) | 6862 | (if (eq type 'class-tag) |
| 6863 | ;; Just one class for tags | 6863 | ;; Just one class for tags |
| 6864 | (setq classes | 6864 | (setq classes |
| 6865 | (list | 6865 | (list |
| 6866 | (idlwave-class-or-superclass-with-tag class-selector x))) | 6866 | (idlwave-class-or-superclass-with-tag class-selector x))) |
| 6867 | ;; Multiple classes for method or method-keyword | 6867 | ;; Multiple classes for method or method-keyword |
| 6868 | (setq classes | 6868 | (setq classes |
| @@ -6871,7 +6871,7 @@ accumulate information on matching completions." | |||
| 6871 | method-selector x type-selector) | 6871 | method-selector x type-selector) |
| 6872 | (idlwave-all-method-classes x type-selector))) | 6872 | (idlwave-all-method-classes x type-selector))) |
| 6873 | (if inherit | 6873 | (if inherit |
| 6874 | (setq classes | 6874 | (setq classes |
| 6875 | (delq nil | 6875 | (delq nil |
| 6876 | (mapcar (lambda (x) (if (memq x inherit) x nil)) | 6876 | (mapcar (lambda (x) (if (memq x inherit) x nil)) |
| 6877 | classes))))) | 6877 | classes))))) |
| @@ -6908,7 +6908,7 @@ accumulate information on matching completions." | |||
| 6908 | (defun idlwave-attach-class-tag-classes (list) | 6908 | (defun idlwave-attach-class-tag-classes (list) |
| 6909 | ;; Call idlwave-attach-classes with class structure tags | 6909 | ;; Call idlwave-attach-classes with class structure tags |
| 6910 | (idlwave-attach-classes list 'class-tag idlwave-completion-show-classes)) | 6910 | (idlwave-attach-classes list 'class-tag idlwave-completion-show-classes)) |
| 6911 | 6911 | ||
| 6912 | 6912 | ||
| 6913 | ;;---------------------------------------------------------------------- | 6913 | ;;---------------------------------------------------------------------- |
| 6914 | ;;---------------------------------------------------------------------- | 6914 | ;;---------------------------------------------------------------------- |
| @@ -6929,7 +6929,7 @@ sort the list before displaying" | |||
| 6929 | ((= 1 (length list)) | 6929 | ((= 1 (length list)) |
| 6930 | (setq rtn (car list))) | 6930 | (setq rtn (car list))) |
| 6931 | ((featurep 'xemacs) | 6931 | ((featurep 'xemacs) |
| 6932 | (if sort (setq list (sort list (lambda (a b) | 6932 | (if sort (setq list (sort list (lambda (a b) |
| 6933 | (string< (upcase a) (upcase b)))))) | 6933 | (string< (upcase a) (upcase b)))))) |
| 6934 | (setq menu | 6934 | (setq menu |
| 6935 | (append (list title) | 6935 | (append (list title) |
| @@ -6940,7 +6940,7 @@ sort the list before displaying" | |||
| 6940 | (setq resp (get-popup-menu-response menu)) | 6940 | (setq resp (get-popup-menu-response menu)) |
| 6941 | (funcall (event-function resp) (event-object resp))) | 6941 | (funcall (event-function resp) (event-object resp))) |
| 6942 | (t | 6942 | (t |
| 6943 | (if sort (setq list (sort list (lambda (a b) | 6943 | (if sort (setq list (sort list (lambda (a b) |
| 6944 | (string< (upcase a) (upcase b)))))) | 6944 | (string< (upcase a) (upcase b)))))) |
| 6945 | (setq menu (cons title | 6945 | (setq menu (cons title |
| 6946 | (list | 6946 | (list |
| @@ -7031,7 +7031,7 @@ sort the list before displaying" | |||
| 7031 | (setq idlwave-before-completion-wconf (current-window-configuration))) | 7031 | (setq idlwave-before-completion-wconf (current-window-configuration))) |
| 7032 | 7032 | ||
| 7033 | (if (featurep 'xemacs) | 7033 | (if (featurep 'xemacs) |
| 7034 | (idlwave-display-completion-list-xemacs | 7034 | (idlwave-display-completion-list-xemacs |
| 7035 | list) | 7035 | list) |
| 7036 | (idlwave-display-completion-list-emacs list)) | 7036 | (idlwave-display-completion-list-emacs list)) |
| 7037 | 7037 | ||
| @@ -7112,7 +7112,7 @@ If these don't exist, a letter in the string is automatically selected." | |||
| 7112 | (mapcar (lambda(x) | 7112 | (mapcar (lambda(x) |
| 7113 | (princ (nth 1 x)) | 7113 | (princ (nth 1 x)) |
| 7114 | (princ "\n")) | 7114 | (princ "\n")) |
| 7115 | keys-alist)) | 7115 | keys-alist)) |
| 7116 | (setq char (read-char))) | 7116 | (setq char (read-char))) |
| 7117 | (setq char (read-char))) | 7117 | (setq char (read-char))) |
| 7118 | (message nil) | 7118 | (message nil) |
| @@ -7232,7 +7232,7 @@ If these don't exist, a letter in the string is automatically selected." | |||
| 7232 | (defun idlwave-make-modified-completion-map-emacs (old-map) | 7232 | (defun idlwave-make-modified-completion-map-emacs (old-map) |
| 7233 | "Replace `choose-completion' and `mouse-choose-completion' in OLD-MAP." | 7233 | "Replace `choose-completion' and `mouse-choose-completion' in OLD-MAP." |
| 7234 | (let ((new-map (copy-keymap old-map))) | 7234 | (let ((new-map (copy-keymap old-map))) |
| 7235 | (substitute-key-definition | 7235 | (substitute-key-definition |
| 7236 | 'choose-completion 'idlwave-choose-completion new-map) | 7236 | 'choose-completion 'idlwave-choose-completion new-map) |
| 7237 | (substitute-key-definition | 7237 | (substitute-key-definition |
| 7238 | 'mouse-choose-completion 'idlwave-mouse-choose-completion new-map) | 7238 | 'mouse-choose-completion 'idlwave-mouse-choose-completion new-map) |
| @@ -7258,8 +7258,8 @@ If these don't exist, a letter in the string is automatically selected." | |||
| 7258 | ;; | 7258 | ;; |
| 7259 | ;; - Go again over the documentation how to write a completion | 7259 | ;; - Go again over the documentation how to write a completion |
| 7260 | ;; plugin. It is in self.el, but currently still very bad. | 7260 | ;; plugin. It is in self.el, but currently still very bad. |
| 7261 | ;; This could be in a separate file in the distribution, or | 7261 | ;; This could be in a separate file in the distribution, or |
| 7262 | ;; in an appendix for the manual. | 7262 | ;; in an appendix for the manual. |
| 7263 | 7263 | ||
| 7264 | (defvar idlwave-struct-skip | 7264 | (defvar idlwave-struct-skip |
| 7265 | "[ \t]*\\(\\$.*\n\\(^[ \t]*\\(\\$[ \t]*\\)?\\(;.*\\)?\n\\)*\\)?[ \t]*" | 7265 | "[ \t]*\\(\\$.*\n\\(^[ \t]*\\(\\$[ \t]*\\)?\\(;.*\\)?\n\\)*\\)?[ \t]*" |
| @@ -7298,7 +7298,7 @@ Point is expected just before the opening `{' of the struct definition." | |||
| 7298 | (beg (car borders)) | 7298 | (beg (car borders)) |
| 7299 | (end (cdr borders)) | 7299 | (end (cdr borders)) |
| 7300 | (case-fold-search t)) | 7300 | (case-fold-search t)) |
| 7301 | (re-search-forward (concat "\\(^[ \t]*\\|[,{][ \t]*\\)" tag "[ \t]*:") | 7301 | (re-search-forward (concat "\\(^[ \t]*\\|[,{][ \t]*\\)" tag "[ \t]*:") |
| 7302 | end t))) | 7302 | end t))) |
| 7303 | 7303 | ||
| 7304 | (defun idlwave-struct-inherits () | 7304 | (defun idlwave-struct-inherits () |
| @@ -7313,7 +7313,7 @@ Point is expected just before the opening `{' of the struct definition." | |||
| 7313 | (goto-char beg) | 7313 | (goto-char beg) |
| 7314 | (save-restriction | 7314 | (save-restriction |
| 7315 | (narrow-to-region beg end) | 7315 | (narrow-to-region beg end) |
| 7316 | (while (re-search-forward | 7316 | (while (re-search-forward |
| 7317 | (concat "[{,]" ;leading comma/brace | 7317 | (concat "[{,]" ;leading comma/brace |
| 7318 | idlwave-struct-skip ; 4 groups | 7318 | idlwave-struct-skip ; 4 groups |
| 7319 | "inherits" ; The INHERITS tag | 7319 | "inherits" ; The INHERITS tag |
| @@ -7363,9 +7363,9 @@ backward." | |||
| 7363 | (concat "\\<" (regexp-quote (downcase var)) "\\>" ws) | 7363 | (concat "\\<" (regexp-quote (downcase var)) "\\>" ws) |
| 7364 | "\\(\\)") | 7364 | "\\(\\)") |
| 7365 | "=" ws "\\({\\)" | 7365 | "=" ws "\\({\\)" |
| 7366 | (if name | 7366 | (if name |
| 7367 | (if (stringp name) | 7367 | (if (stringp name) |
| 7368 | (concat ws "\\(\\<" (downcase name) "\\)[^a-zA-Z0-9_$]") | 7368 | (concat ws "\\(\\<" (downcase name) "\\)[^a-zA-Z0-9_$]") |
| 7369 | ;; Just a generic name | 7369 | ;; Just a generic name |
| 7370 | (concat ws "\\<\\([a-zA-Z_0-9$]+\\)" ws ",")) | 7370 | (concat ws "\\<\\([a-zA-Z_0-9$]+\\)" ws ",")) |
| 7371 | "")))) | 7371 | "")))) |
| @@ -7376,7 +7376,7 @@ backward." | |||
| 7376 | (goto-char (match-beginning 3)) | 7376 | (goto-char (match-beginning 3)) |
| 7377 | (match-string-no-properties 5))))) | 7377 | (match-string-no-properties 5))))) |
| 7378 | 7378 | ||
| 7379 | (defvar idlwave-class-info nil) | 7379 | (defvar idlwave-class-info nil) |
| 7380 | (defvar idlwave-class-reset nil) ; to reset buffer-local classes | 7380 | (defvar idlwave-class-reset nil) ; to reset buffer-local classes |
| 7381 | 7381 | ||
| 7382 | (add-hook 'idlwave-update-rinfo-hook | 7382 | (add-hook 'idlwave-update-rinfo-hook |
| @@ -7388,13 +7388,13 @@ backward." | |||
| 7388 | (let (list entry) | 7388 | (let (list entry) |
| 7389 | (if idlwave-class-info | 7389 | (if idlwave-class-info |
| 7390 | (if idlwave-class-reset | 7390 | (if idlwave-class-reset |
| 7391 | (setq | 7391 | (setq |
| 7392 | idlwave-class-reset nil | 7392 | idlwave-class-reset nil |
| 7393 | idlwave-class-info ; Remove any visited in a buffer | 7393 | idlwave-class-info ; Remove any visited in a buffer |
| 7394 | (delq nil (mapcar | 7394 | (delq nil (mapcar |
| 7395 | (lambda (x) | 7395 | (lambda (x) |
| 7396 | (let ((filebuf | 7396 | (let ((filebuf |
| 7397 | (idlwave-class-file-or-buffer | 7397 | (idlwave-class-file-or-buffer |
| 7398 | (or (cdr (assq 'found-in x)) (car x))))) | 7398 | (or (cdr (assq 'found-in x)) (car x))))) |
| 7399 | (if (cdr filebuf) | 7399 | (if (cdr filebuf) |
| 7400 | nil | 7400 | nil |
| @@ -7432,7 +7432,7 @@ class/struct definition" | |||
| 7432 | (progn | 7432 | (progn |
| 7433 | ;; For everything there | 7433 | ;; For everything there |
| 7434 | (setq end-lim (save-excursion (idlwave-end-of-subprogram) (point))) | 7434 | (setq end-lim (save-excursion (idlwave-end-of-subprogram) (point))) |
| 7435 | (while (setq name | 7435 | (while (setq name |
| 7436 | (idlwave-find-structure-definition nil t end-lim)) | 7436 | (idlwave-find-structure-definition nil t end-lim)) |
| 7437 | (funcall all-hook name))) | 7437 | (funcall all-hook name))) |
| 7438 | (idlwave-find-structure-definition nil (or alt-class class)))))) | 7438 | (idlwave-find-structure-definition nil (or alt-class class)))))) |
| @@ -7470,11 +7470,11 @@ class/struct definition" | |||
| 7470 | (insert-file-contents file)) | 7470 | (insert-file-contents file)) |
| 7471 | (save-excursion | 7471 | (save-excursion |
| 7472 | (goto-char 1) | 7472 | (goto-char 1) |
| 7473 | (idlwave-find-class-definition class | 7473 | (idlwave-find-class-definition class |
| 7474 | ;; Scan all of the structures found there | 7474 | ;; Scan all of the structures found there |
| 7475 | (lambda (name) | 7475 | (lambda (name) |
| 7476 | (let* ((this-class (idlwave-sintern-class name)) | 7476 | (let* ((this-class (idlwave-sintern-class name)) |
| 7477 | (entry | 7477 | (entry |
| 7478 | (list this-class | 7478 | (list this-class |
| 7479 | (cons 'tags (idlwave-struct-tags)) | 7479 | (cons 'tags (idlwave-struct-tags)) |
| 7480 | (cons 'inherits (idlwave-struct-inherits))))) | 7480 | (cons 'inherits (idlwave-struct-inherits))))) |
| @@ -7499,7 +7499,7 @@ class/struct definition" | |||
| 7499 | (condition-case err | 7499 | (condition-case err |
| 7500 | (apply 'append (mapcar 'idlwave-class-tags | 7500 | (apply 'append (mapcar 'idlwave-class-tags |
| 7501 | (cons class (idlwave-all-class-inherits class)))) | 7501 | (cons class (idlwave-all-class-inherits class)))) |
| 7502 | (error | 7502 | (error |
| 7503 | (idlwave-class-tag-reset) | 7503 | (idlwave-class-tag-reset) |
| 7504 | (error "%s" (error-message-string err))))) | 7504 | (error "%s" (error-message-string err))))) |
| 7505 | 7505 | ||
| @@ -7536,24 +7536,24 @@ The list is cached in `idlwave-class-info' for faster access." | |||
| 7536 | all-inherits)))))) | 7536 | all-inherits)))))) |
| 7537 | 7537 | ||
| 7538 | (defun idlwave-entry-keywords (entry &optional record-link) | 7538 | (defun idlwave-entry-keywords (entry &optional record-link) |
| 7539 | "Return the flat entry keywords alist from routine-info entry. | 7539 | "Return the flat entry keywords alist from routine-info entry. |
| 7540 | If RECORD-LINK is non-nil, the keyword text is copied and a text | 7540 | If RECORD-LINK is non-nil, the keyword text is copied and a text |
| 7541 | property indicating the link is added." | 7541 | property indicating the link is added." |
| 7542 | (let (kwds) | 7542 | (let (kwds) |
| 7543 | (mapcar | 7543 | (mapcar |
| 7544 | (lambda (key-list) | 7544 | (lambda (key-list) |
| 7545 | (let ((file (car key-list))) | 7545 | (let ((file (car key-list))) |
| 7546 | (mapcar (lambda (key-cons) | 7546 | (mapcar (lambda (key-cons) |
| 7547 | (let ((key (car key-cons)) | 7547 | (let ((key (car key-cons)) |
| 7548 | (link (cdr key-cons))) | 7548 | (link (cdr key-cons))) |
| 7549 | (when (and record-link file) | 7549 | (when (and record-link file) |
| 7550 | (setq key (copy-sequence key)) | 7550 | (setq key (copy-sequence key)) |
| 7551 | (put-text-property | 7551 | (put-text-property |
| 7552 | 0 (length key) | 7552 | 0 (length key) |
| 7553 | 'link | 7553 | 'link |
| 7554 | (concat | 7554 | (concat |
| 7555 | file | 7555 | file |
| 7556 | (if link | 7556 | (if link |
| 7557 | (concat idlwave-html-link-sep | 7557 | (concat idlwave-html-link-sep |
| 7558 | (number-to-string link)))) | 7558 | (number-to-string link)))) |
| 7559 | key)) | 7559 | key)) |
| @@ -7566,13 +7566,13 @@ property indicating the link is added." | |||
| 7566 | "Find keyword KEYWORD in entry ENTRY, and return (with link) if set" | 7566 | "Find keyword KEYWORD in entry ENTRY, and return (with link) if set" |
| 7567 | (catch 'exit | 7567 | (catch 'exit |
| 7568 | (mapc | 7568 | (mapc |
| 7569 | (lambda (key-list) | 7569 | (lambda (key-list) |
| 7570 | (let ((file (car key-list)) | 7570 | (let ((file (car key-list)) |
| 7571 | (kwd (assoc keyword (cdr key-list)))) | 7571 | (kwd (assoc keyword (cdr key-list)))) |
| 7572 | (when kwd | 7572 | (when kwd |
| 7573 | (setq kwd (cons (car kwd) | 7573 | (setq kwd (cons (car kwd) |
| 7574 | (if (and file (cdr kwd)) | 7574 | (if (and file (cdr kwd)) |
| 7575 | (concat file | 7575 | (concat file |
| 7576 | idlwave-html-link-sep | 7576 | idlwave-html-link-sep |
| 7577 | (number-to-string (cdr kwd))) | 7577 | (number-to-string (cdr kwd))) |
| 7578 | (cdr kwd)))) | 7578 | (cdr kwd)))) |
| @@ -7610,14 +7610,14 @@ property indicating the link is added." | |||
| 7610 | ;; Check if we need to update the "current" class | 7610 | ;; Check if we need to update the "current" class |
| 7611 | (if (not (equal class-selector idlwave-current-tags-class)) | 7611 | (if (not (equal class-selector idlwave-current-tags-class)) |
| 7612 | (idlwave-prepare-class-tag-completion class-selector)) | 7612 | (idlwave-prepare-class-tag-completion class-selector)) |
| 7613 | (setq idlwave-completion-help-info | 7613 | (setq idlwave-completion-help-info |
| 7614 | (list 'idlwave-complete-class-structure-tag-help | 7614 | (list 'idlwave-complete-class-structure-tag-help |
| 7615 | (idlwave-sintern-routine | 7615 | (idlwave-sintern-routine |
| 7616 | (concat class-selector "__define")) | 7616 | (concat class-selector "__define")) |
| 7617 | nil)) | 7617 | nil)) |
| 7618 | (let ((idlwave-cpl-bold idlwave-current-native-class-tags)) | 7618 | (let ((idlwave-cpl-bold idlwave-current-native-class-tags)) |
| 7619 | (idlwave-complete-in-buffer | 7619 | (idlwave-complete-in-buffer |
| 7620 | 'class-tag 'class-tag | 7620 | 'class-tag 'class-tag |
| 7621 | idlwave-current-class-tags nil | 7621 | idlwave-current-class-tags nil |
| 7622 | (format "Select a tag of class %s" class-selector) | 7622 | (format "Select a tag of class %s" class-selector) |
| 7623 | "class tag" | 7623 | "class tag" |
| @@ -7663,7 +7663,7 @@ property indicating the link is added." | |||
| 7663 | (skip-chars-backward "[a-zA-Z0-9_$]") | 7663 | (skip-chars-backward "[a-zA-Z0-9_$]") |
| 7664 | (equal (char-before) ?!)) | 7664 | (equal (char-before) ?!)) |
| 7665 | (setq idlwave-completion-help-info '(idlwave-complete-sysvar-help)) | 7665 | (setq idlwave-completion-help-info '(idlwave-complete-sysvar-help)) |
| 7666 | (idlwave-complete-in-buffer 'sysvar 'sysvar | 7666 | (idlwave-complete-in-buffer 'sysvar 'sysvar |
| 7667 | idlwave-system-variables-alist nil | 7667 | idlwave-system-variables-alist nil |
| 7668 | "Select a system variable" | 7668 | "Select a system variable" |
| 7669 | "system variable") | 7669 | "system variable") |
| @@ -7682,7 +7682,7 @@ property indicating the link is added." | |||
| 7682 | (or tags (error "System variable !%s is not a structure" var)) | 7682 | (or tags (error "System variable !%s is not a structure" var)) |
| 7683 | (setq idlwave-completion-help-info | 7683 | (setq idlwave-completion-help-info |
| 7684 | (list 'idlwave-complete-sysvar-tag-help var)) | 7684 | (list 'idlwave-complete-sysvar-tag-help var)) |
| 7685 | (idlwave-complete-in-buffer 'sysvartag 'sysvartag | 7685 | (idlwave-complete-in-buffer 'sysvartag 'sysvartag |
| 7686 | tags nil | 7686 | tags nil |
| 7687 | "Select a system variable tag" | 7687 | "Select a system variable tag" |
| 7688 | "system variable tag") | 7688 | "system variable tag") |
| @@ -7711,8 +7711,8 @@ property indicating the link is added." | |||
| 7711 | ((eq mode 'test) ; we can at least link the main | 7711 | ((eq mode 'test) ; we can at least link the main |
| 7712 | (and (stringp word) entry main)) | 7712 | (and (stringp word) entry main)) |
| 7713 | ((eq mode 'set) | 7713 | ((eq mode 'set) |
| 7714 | (if entry | 7714 | (if entry |
| 7715 | (setq link | 7715 | (setq link |
| 7716 | (if (setq target (cdr (assoc word tags))) | 7716 | (if (setq target (cdr (assoc word tags))) |
| 7717 | (idlwave-substitute-link-target main target) | 7717 | (idlwave-substitute-link-target main target) |
| 7718 | main)))) ;; setting dynamic!!! | 7718 | main)))) ;; setting dynamic!!! |
| @@ -7736,7 +7736,7 @@ property indicating the link is added." | |||
| 7736 | 7736 | ||
| 7737 | ;; Fake help in the source buffer for class structure tags. | 7737 | ;; Fake help in the source buffer for class structure tags. |
| 7738 | ;; KWD AND NAME ARE GLOBAL-VARIABLES HERE. | 7738 | ;; KWD AND NAME ARE GLOBAL-VARIABLES HERE. |
| 7739 | (defvar name) | 7739 | (defvar name) |
| 7740 | (defvar kwd) | 7740 | (defvar kwd) |
| 7741 | (defvar idlwave-help-do-class-struct-tag nil) | 7741 | (defvar idlwave-help-do-class-struct-tag nil) |
| 7742 | (defun idlwave-complete-class-structure-tag-help (mode word) | 7742 | (defun idlwave-complete-class-structure-tag-help (mode word) |
| @@ -7745,11 +7745,11 @@ property indicating the link is added." | |||
| 7745 | nil) | 7745 | nil) |
| 7746 | ((eq mode 'set) | 7746 | ((eq mode 'set) |
| 7747 | (let (class-with found-in) | 7747 | (let (class-with found-in) |
| 7748 | (when (setq class-with | 7748 | (when (setq class-with |
| 7749 | (idlwave-class-or-superclass-with-tag | 7749 | (idlwave-class-or-superclass-with-tag |
| 7750 | idlwave-current-tags-class | 7750 | idlwave-current-tags-class |
| 7751 | word)) | 7751 | word)) |
| 7752 | (if (assq (idlwave-sintern-class class-with) | 7752 | (if (assq (idlwave-sintern-class class-with) |
| 7753 | idlwave-system-class-info) | 7753 | idlwave-system-class-info) |
| 7754 | (error "No help available for system class tags")) | 7754 | (error "No help available for system class tags")) |
| 7755 | (if (setq found-in (idlwave-class-found-in class-with)) | 7755 | (if (setq found-in (idlwave-class-found-in class-with)) |
| @@ -7762,7 +7762,7 @@ property indicating the link is added." | |||
| 7762 | (defun idlwave-class-or-superclass-with-tag (class tag) | 7762 | (defun idlwave-class-or-superclass-with-tag (class tag) |
| 7763 | "Find and return the CLASS or one of its superclass with the | 7763 | "Find and return the CLASS or one of its superclass with the |
| 7764 | associated TAG, if any." | 7764 | associated TAG, if any." |
| 7765 | (let ((sclasses (cons class (cdr (assq 'all-inherits | 7765 | (let ((sclasses (cons class (cdr (assq 'all-inherits |
| 7766 | (idlwave-class-info class))))) | 7766 | (idlwave-class-info class))))) |
| 7767 | cl) | 7767 | cl) |
| 7768 | (catch 'exit | 7768 | (catch 'exit |
| @@ -7771,7 +7771,7 @@ associated TAG, if any." | |||
| 7771 | (let ((tags (idlwave-class-tags cl))) | 7771 | (let ((tags (idlwave-class-tags cl))) |
| 7772 | (while tags | 7772 | (while tags |
| 7773 | (if (eq t (compare-strings tag 0 nil (car tags) 0 nil t)) | 7773 | (if (eq t (compare-strings tag 0 nil (car tags) 0 nil t)) |
| 7774 | (throw 'exit cl)) | 7774 | (throw 'exit cl)) |
| 7775 | (setq tags (cdr tags)))))))) | 7775 | (setq tags (cdr tags)))))))) |
| 7776 | 7776 | ||
| 7777 | 7777 | ||
| @@ -7794,8 +7794,8 @@ associated TAG, if any." | |||
| 7794 | (setcar entry (idlwave-sintern-sysvar (car entry) 'set)) | 7794 | (setcar entry (idlwave-sintern-sysvar (car entry) 'set)) |
| 7795 | (setq tags (assq 'tags entry)) | 7795 | (setq tags (assq 'tags entry)) |
| 7796 | (if tags | 7796 | (if tags |
| 7797 | (setcdr tags | 7797 | (setcdr tags |
| 7798 | (mapcar (lambda (x) | 7798 | (mapcar (lambda (x) |
| 7799 | (cons (idlwave-sintern-sysvartag (car x) 'set) | 7799 | (cons (idlwave-sintern-sysvartag (car x) 'set) |
| 7800 | (cdr x))) | 7800 | (cdr x))) |
| 7801 | (cdr tags))))))) | 7801 | (cdr tags))))))) |
| @@ -7812,19 +7812,19 @@ associated TAG, if any." | |||
| 7812 | text start) | 7812 | text start) |
| 7813 | (setq start (match-end 0) | 7813 | (setq start (match-end 0) |
| 7814 | var (match-string 1 text) | 7814 | var (match-string 1 text) |
| 7815 | tags (if (match-end 3) | 7815 | tags (if (match-end 3) |
| 7816 | (idlwave-split-string (match-string 3 text)))) | 7816 | (idlwave-split-string (match-string 3 text)))) |
| 7817 | ;; Maintain old links, if present | 7817 | ;; Maintain old links, if present |
| 7818 | (setq old-entry (assq (idlwave-sintern-sysvar var) old)) | 7818 | (setq old-entry (assq (idlwave-sintern-sysvar var) old)) |
| 7819 | (setq link (assq 'link old-entry)) | 7819 | (setq link (assq 'link old-entry)) |
| 7820 | (setq idlwave-system-variables-alist | 7820 | (setq idlwave-system-variables-alist |
| 7821 | (cons (list var | 7821 | (cons (list var |
| 7822 | (cons | 7822 | (cons |
| 7823 | 'tags | 7823 | 'tags |
| 7824 | (mapcar (lambda (x) | 7824 | (mapcar (lambda (x) |
| 7825 | (cons x | 7825 | (cons x |
| 7826 | (cdr (assq | 7826 | (cdr (assq |
| 7827 | (idlwave-sintern-sysvartag x) | 7827 | (idlwave-sintern-sysvartag x) |
| 7828 | (cdr (assq 'tags old-entry)))))) | 7828 | (cdr (assq 'tags old-entry)))))) |
| 7829 | tags)) link) | 7829 | tags)) link) |
| 7830 | idlwave-system-variables-alist))) | 7830 | idlwave-system-variables-alist))) |
| @@ -7846,9 +7846,9 @@ associated TAG, if any." | |||
| 7846 | 7846 | ||
| 7847 | (defun idlwave-uniquify (list) | 7847 | (defun idlwave-uniquify (list) |
| 7848 | (let ((ht (make-hash-table :size (length list) :test 'equal))) | 7848 | (let ((ht (make-hash-table :size (length list) :test 'equal))) |
| 7849 | (delq nil | 7849 | (delq nil |
| 7850 | (mapcar (lambda (x) | 7850 | (mapcar (lambda (x) |
| 7851 | (unless (gethash x ht) | 7851 | (unless (gethash x ht) |
| 7852 | (puthash x t ht) | 7852 | (puthash x t ht) |
| 7853 | x)) | 7853 | x)) |
| 7854 | list)))) | 7854 | list)))) |
| @@ -7876,11 +7876,11 @@ Restore the pre-completion window configuration if possible." | |||
| 7876 | nil))) | 7876 | nil))) |
| 7877 | 7877 | ||
| 7878 | ;; Restore the pre-completion window configuration if this is safe. | 7878 | ;; Restore the pre-completion window configuration if this is safe. |
| 7879 | 7879 | ||
| 7880 | (if (or (eq verify 'force) ; force | 7880 | (if (or (eq verify 'force) ; force |
| 7881 | (and | 7881 | (and |
| 7882 | (get-buffer-window "*Completions*") ; visible | 7882 | (get-buffer-window "*Completions*") ; visible |
| 7883 | (idlwave-local-value 'idlwave-completion-p | 7883 | (idlwave-local-value 'idlwave-completion-p |
| 7884 | "*Completions*") ; cib-buffer | 7884 | "*Completions*") ; cib-buffer |
| 7885 | (eq (marker-buffer idlwave-completion-mark) | 7885 | (eq (marker-buffer idlwave-completion-mark) |
| 7886 | (current-buffer)) ; buffer OK | 7886 | (current-buffer)) ; buffer OK |
| @@ -7978,7 +7978,7 @@ With ARG, enforce query for the class of object methods." | |||
| 7978 | (if (string-match "\\(pro\\|function\\)[ \t]+\\(\\(.*\\)::\\)?\\(.*\\)" | 7978 | (if (string-match "\\(pro\\|function\\)[ \t]+\\(\\(.*\\)::\\)?\\(.*\\)" |
| 7979 | resolve) | 7979 | resolve) |
| 7980 | (setq type (match-string 1 resolve) | 7980 | (setq type (match-string 1 resolve) |
| 7981 | class (if (match-beginning 2) | 7981 | class (if (match-beginning 2) |
| 7982 | (match-string 3 resolve) | 7982 | (match-string 3 resolve) |
| 7983 | nil) | 7983 | nil) |
| 7984 | name (match-string 4 resolve))) | 7984 | name (match-string 4 resolve))) |
| @@ -7987,15 +7987,15 @@ With ARG, enforce query for the class of object methods." | |||
| 7987 | 7987 | ||
| 7988 | (cond | 7988 | (cond |
| 7989 | ((null class) | 7989 | ((null class) |
| 7990 | (idlwave-shell-send-command | 7990 | (idlwave-shell-send-command |
| 7991 | (format "resolve_routine,'%s'%s" (downcase name) kwd) | 7991 | (format "resolve_routine,'%s'%s" (downcase name) kwd) |
| 7992 | 'idlwave-update-routine-info | 7992 | 'idlwave-update-routine-info |
| 7993 | nil t)) | 7993 | nil t)) |
| 7994 | (t | 7994 | (t |
| 7995 | (idlwave-shell-send-command | 7995 | (idlwave-shell-send-command |
| 7996 | (format "resolve_routine,'%s__define'%s" (downcase class) kwd) | 7996 | (format "resolve_routine,'%s__define'%s" (downcase class) kwd) |
| 7997 | (list 'idlwave-shell-send-command | 7997 | (list 'idlwave-shell-send-command |
| 7998 | (format "resolve_routine,'%s__%s'%s" | 7998 | (format "resolve_routine,'%s__%s'%s" |
| 7999 | (downcase class) (downcase name) kwd) | 7999 | (downcase class) (downcase name) kwd) |
| 8000 | '(idlwave-update-routine-info) | 8000 | '(idlwave-update-routine-info) |
| 8001 | nil t)))))) | 8001 | nil t)))))) |
| @@ -8016,19 +8016,19 @@ force class query for object methods." | |||
| 8016 | (this-buffer (equal arg '(4))) | 8016 | (this-buffer (equal arg '(4))) |
| 8017 | (module (idlwave-fix-module-if-obj_new (idlwave-what-module))) | 8017 | (module (idlwave-fix-module-if-obj_new (idlwave-what-module))) |
| 8018 | (default (if module | 8018 | (default (if module |
| 8019 | (concat (idlwave-make-full-name | 8019 | (concat (idlwave-make-full-name |
| 8020 | (nth 2 module) (car module)) | 8020 | (nth 2 module) (car module)) |
| 8021 | (if (eq (nth 1 module) 'pro) "<p>" "<f>")) | 8021 | (if (eq (nth 1 module) 'pro) "<p>" "<f>")) |
| 8022 | "none")) | 8022 | "none")) |
| 8023 | (list | 8023 | (list |
| 8024 | (idlwave-uniquify | 8024 | (idlwave-uniquify |
| 8025 | (delq nil | 8025 | (delq nil |
| 8026 | (mapcar (lambda (x) | 8026 | (mapcar (lambda (x) |
| 8027 | (if (eq 'system (car-safe (nth 3 x))) | 8027 | (if (eq 'system (car-safe (nth 3 x))) |
| 8028 | ;; Take out system routines with no source. | 8028 | ;; Take out system routines with no source. |
| 8029 | nil | 8029 | nil |
| 8030 | (list | 8030 | (list |
| 8031 | (concat (idlwave-make-full-name | 8031 | (concat (idlwave-make-full-name |
| 8032 | (nth 2 x) (car x)) | 8032 | (nth 2 x) (car x)) |
| 8033 | (if (eq (nth 1 x) 'pro) "<p>" "<f>"))))) | 8033 | (if (eq (nth 1 x) 'pro) "<p>" "<f>"))))) |
| 8034 | (if this-buffer | 8034 | (if this-buffer |
| @@ -8057,10 +8057,10 @@ force class query for object methods." | |||
| 8057 | (t t))) | 8057 | (t t))) |
| 8058 | (idlwave-do-find-module name type class nil this-buffer))) | 8058 | (idlwave-do-find-module name type class nil this-buffer))) |
| 8059 | 8059 | ||
| 8060 | (defun idlwave-do-find-module (name type class | 8060 | (defun idlwave-do-find-module (name type class |
| 8061 | &optional force-source this-buffer) | 8061 | &optional force-source this-buffer) |
| 8062 | (let ((name1 (idlwave-make-full-name class name)) | 8062 | (let ((name1 (idlwave-make-full-name class name)) |
| 8063 | source buf1 entry | 8063 | source buf1 entry |
| 8064 | (buf (current-buffer)) | 8064 | (buf (current-buffer)) |
| 8065 | (pos (point)) | 8065 | (pos (point)) |
| 8066 | file name2) | 8066 | file name2) |
| @@ -8070,11 +8070,11 @@ force class query for object methods." | |||
| 8070 | name2 (if (nth 2 entry) | 8070 | name2 (if (nth 2 entry) |
| 8071 | (idlwave-make-full-name (nth 2 entry) name) | 8071 | (idlwave-make-full-name (nth 2 entry) name) |
| 8072 | name1)) | 8072 | name1)) |
| 8073 | (if source | 8073 | (if source |
| 8074 | (setq file (idlwave-routine-source-file source))) | 8074 | (setq file (idlwave-routine-source-file source))) |
| 8075 | (unless file ; Try to find it on the path. | 8075 | (unless file ; Try to find it on the path. |
| 8076 | (setq file | 8076 | (setq file |
| 8077 | (idlwave-expand-lib-file-name | 8077 | (idlwave-expand-lib-file-name |
| 8078 | (if class | 8078 | (if class |
| 8079 | (format "%s__define.pro" (downcase class)) | 8079 | (format "%s__define.pro" (downcase class)) |
| 8080 | (format "%s.pro" (downcase name)))))) | 8080 | (format "%s.pro" (downcase name)))))) |
| @@ -8082,14 +8082,14 @@ force class query for object methods." | |||
| 8082 | ((or (null name) (equal name "")) | 8082 | ((or (null name) (equal name "")) |
| 8083 | (error "Abort")) | 8083 | (error "Abort")) |
| 8084 | ((eq (car source) 'system) | 8084 | ((eq (car source) 'system) |
| 8085 | (error "Source code for system routine %s is not available" | 8085 | (error "Source code for system routine %s is not available" |
| 8086 | name2)) | 8086 | name2)) |
| 8087 | ((or (not file) (not (file-regular-p file))) | 8087 | ((or (not file) (not (file-regular-p file))) |
| 8088 | (error "Source code for routine %s is not available" | 8088 | (error "Source code for routine %s is not available" |
| 8089 | name2)) | 8089 | name2)) |
| 8090 | (t | 8090 | (t |
| 8091 | (when (not this-buffer) | 8091 | (when (not this-buffer) |
| 8092 | (setq buf1 | 8092 | (setq buf1 |
| 8093 | (idlwave-find-file-noselect file 'find)) | 8093 | (idlwave-find-file-noselect file 'find)) |
| 8094 | (pop-to-buffer buf1 t)) | 8094 | (pop-to-buffer buf1 t)) |
| 8095 | (goto-char (point-max)) | 8095 | (goto-char (point-max)) |
| @@ -8099,7 +8099,7 @@ force class query for object methods." | |||
| 8099 | (cond ((eq type 'fun) "function") | 8099 | (cond ((eq type 'fun) "function") |
| 8100 | ((eq type 'pro) "pro") | 8100 | ((eq type 'pro) "pro") |
| 8101 | (t "\\(pro\\|function\\)")) | 8101 | (t "\\(pro\\|function\\)")) |
| 8102 | "\\>[ \t]+" | 8102 | "\\>[ \t]+" |
| 8103 | (regexp-quote (downcase name2)) | 8103 | (regexp-quote (downcase name2)) |
| 8104 | "[^a-zA-Z0-9_$]") | 8104 | "[^a-zA-Z0-9_$]") |
| 8105 | nil t) | 8105 | nil t) |
| @@ -8136,17 +8136,17 @@ Used by `idlwave-routine-info' and `idlwave-find-module'." | |||
| 8136 | (cond | 8136 | (cond |
| 8137 | ((and (eq cw 'procedure) | 8137 | ((and (eq cw 'procedure) |
| 8138 | (not (equal this-word ""))) | 8138 | (not (equal this-word ""))) |
| 8139 | (setq this-word (idlwave-sintern-routine-or-method | 8139 | (setq this-word (idlwave-sintern-routine-or-method |
| 8140 | this-word (nth 2 (nth 3 where)))) | 8140 | this-word (nth 2 (nth 3 where)))) |
| 8141 | (list this-word 'pro | 8141 | (list this-word 'pro |
| 8142 | (idlwave-determine-class | 8142 | (idlwave-determine-class |
| 8143 | (cons this-word (cdr (nth 3 where))) | 8143 | (cons this-word (cdr (nth 3 where))) |
| 8144 | 'pro))) | 8144 | 'pro))) |
| 8145 | ((and (eq cw 'function) | 8145 | ((and (eq cw 'function) |
| 8146 | (not (equal this-word "")) | 8146 | (not (equal this-word "")) |
| 8147 | (or (eq next-char ?\() ; exclude arrays, vars. | 8147 | (or (eq next-char ?\() ; exclude arrays, vars. |
| 8148 | (looking-at "[a-zA-Z0-9_]*[ \t]*("))) | 8148 | (looking-at "[a-zA-Z0-9_]*[ \t]*("))) |
| 8149 | (setq this-word (idlwave-sintern-routine-or-method | 8149 | (setq this-word (idlwave-sintern-routine-or-method |
| 8150 | this-word (nth 2 (nth 3 where)))) | 8150 | this-word (nth 2 (nth 3 where)))) |
| 8151 | (list this-word 'fun | 8151 | (list this-word 'fun |
| 8152 | (idlwave-determine-class | 8152 | (idlwave-determine-class |
| @@ -8183,7 +8183,7 @@ Used by `idlwave-routine-info' and `idlwave-find-module'." | |||
| 8183 | class))) | 8183 | class))) |
| 8184 | 8184 | ||
| 8185 | (defun idlwave-fix-module-if-obj_new (module) | 8185 | (defun idlwave-fix-module-if-obj_new (module) |
| 8186 | "Check if MODULE points to obj_new. | 8186 | "Check if MODULE points to obj_new. |
| 8187 | If yes, and if the cursor is in the keyword region, change to the | 8187 | If yes, and if the cursor is in the keyword region, change to the |
| 8188 | appropriate Init method." | 8188 | appropriate Init method." |
| 8189 | (let* ((name (car module)) | 8189 | (let* ((name (car module)) |
| @@ -8204,7 +8204,7 @@ appropriate Init method." | |||
| 8204 | (idlwave-sintern-class class))))) | 8204 | (idlwave-sintern-class class))))) |
| 8205 | module)) | 8205 | module)) |
| 8206 | 8206 | ||
| 8207 | (defun idlwave-fix-keywords (name type class keywords | 8207 | (defun idlwave-fix-keywords (name type class keywords |
| 8208 | &optional super-classes system) | 8208 | &optional super-classes system) |
| 8209 | "Update a list of keywords. | 8209 | "Update a list of keywords. |
| 8210 | Translate OBJ_NEW, adding all super-class keywords, or all keywords | 8210 | Translate OBJ_NEW, adding all super-class keywords, or all keywords |
| @@ -8225,34 +8225,34 @@ demand _EXTRA in the keyword list." | |||
| 8225 | string) | 8225 | string) |
| 8226 | (setq class (idlwave-sintern-class (match-string 1 string))) | 8226 | (setq class (idlwave-sintern-class (match-string 1 string))) |
| 8227 | (setq idlwave-current-obj_new-class class) | 8227 | (setq idlwave-current-obj_new-class class) |
| 8228 | (setq keywords | 8228 | (setq keywords |
| 8229 | (append keywords | 8229 | (append keywords |
| 8230 | (idlwave-entry-keywords | 8230 | (idlwave-entry-keywords |
| 8231 | (idlwave-rinfo-assq | 8231 | (idlwave-rinfo-assq |
| 8232 | (idlwave-sintern-method "INIT") | 8232 | (idlwave-sintern-method "INIT") |
| 8233 | 'fun | 8233 | 'fun |
| 8234 | class | 8234 | class |
| 8235 | (idlwave-routines)) 'do-link)))))) | 8235 | (idlwave-routines)) 'do-link)))))) |
| 8236 | 8236 | ||
| 8237 | ;; If the class is `t', combine all keywords of all methods NAME | 8237 | ;; If the class is `t', combine all keywords of all methods NAME |
| 8238 | (when (eq class t) | 8238 | (when (eq class t) |
| 8239 | (mapc (lambda (entry) | 8239 | (mapc (lambda (entry) |
| 8240 | (and | 8240 | (and |
| 8241 | (nth 2 entry) ; non-nil class | 8241 | (nth 2 entry) ; non-nil class |
| 8242 | (eq (nth 1 entry) type) ; correct type | 8242 | (eq (nth 1 entry) type) ; correct type |
| 8243 | (setq keywords | 8243 | (setq keywords |
| 8244 | (append keywords | 8244 | (append keywords |
| 8245 | (idlwave-entry-keywords entry 'do-link))))) | 8245 | (idlwave-entry-keywords entry 'do-link))))) |
| 8246 | (idlwave-all-assq name (idlwave-routines))) | 8246 | (idlwave-all-assq name (idlwave-routines))) |
| 8247 | (setq keywords (idlwave-uniquify keywords))) | 8247 | (setq keywords (idlwave-uniquify keywords))) |
| 8248 | 8248 | ||
| 8249 | ;; If we have inheritance, add all keywords from superclasses, if | 8249 | ;; If we have inheritance, add all keywords from superclasses, if |
| 8250 | ;; the user indicated that method in `idlwave-keyword-class-inheritance' | 8250 | ;; the user indicated that method in `idlwave-keyword-class-inheritance' |
| 8251 | (when (and | 8251 | (when (and |
| 8252 | super-classes | 8252 | super-classes |
| 8253 | idlwave-keyword-class-inheritance | 8253 | idlwave-keyword-class-inheritance |
| 8254 | (stringp class) | 8254 | (stringp class) |
| 8255 | (or | 8255 | (or |
| 8256 | system | 8256 | system |
| 8257 | (assq (idlwave-sintern-keyword "_extra") keywords) | 8257 | (assq (idlwave-sintern-keyword "_extra") keywords) |
| 8258 | (assq (idlwave-sintern-keyword "_ref_extra") keywords)) | 8258 | (assq (idlwave-sintern-keyword "_ref_extra") keywords)) |
| @@ -8270,7 +8270,7 @@ demand _EXTRA in the keyword list." | |||
| 8270 | (mapcar (lambda (k) (add-to-list 'keywords k)) | 8270 | (mapcar (lambda (k) (add-to-list 'keywords k)) |
| 8271 | (idlwave-entry-keywords entry 'do-link)))) | 8271 | (idlwave-entry-keywords entry 'do-link)))) |
| 8272 | (setq keywords (idlwave-uniquify keywords))) | 8272 | (setq keywords (idlwave-uniquify keywords))) |
| 8273 | 8273 | ||
| 8274 | ;; Return the final list | 8274 | ;; Return the final list |
| 8275 | keywords)) | 8275 | keywords)) |
| 8276 | 8276 | ||
| @@ -8295,14 +8295,14 @@ If we do not know about MODULE, just return KEYWORD literally." | |||
| 8295 | (assq (idlwave-sintern-keyword "_REF_EXTRA") kwd-alist))) | 8295 | (assq (idlwave-sintern-keyword "_REF_EXTRA") kwd-alist))) |
| 8296 | (completion-ignore-case t) | 8296 | (completion-ignore-case t) |
| 8297 | candidates) | 8297 | candidates) |
| 8298 | (cond ((assq kwd kwd-alist) | 8298 | (cond ((assq kwd kwd-alist) |
| 8299 | kwd) | 8299 | kwd) |
| 8300 | ((setq candidates (all-completions kwd kwd-alist)) | 8300 | ((setq candidates (all-completions kwd kwd-alist)) |
| 8301 | (if (= (length candidates) 1) | 8301 | (if (= (length candidates) 1) |
| 8302 | (car candidates) | 8302 | (car candidates) |
| 8303 | candidates)) | 8303 | candidates)) |
| 8304 | ((and entry extra) | 8304 | ((and entry extra) |
| 8305 | ;; Inheritance may cause this keyword to be correct | 8305 | ;; Inheritance may cause this keyword to be correct |
| 8306 | keyword) | 8306 | keyword) |
| 8307 | (entry | 8307 | (entry |
| 8308 | ;; We do know the function, which does not have the keyword. | 8308 | ;; We do know the function, which does not have the keyword. |
| @@ -8314,13 +8314,13 @@ If we do not know about MODULE, just return KEYWORD literally." | |||
| 8314 | 8314 | ||
| 8315 | (defvar idlwave-rinfo-mouse-map (make-sparse-keymap)) | 8315 | (defvar idlwave-rinfo-mouse-map (make-sparse-keymap)) |
| 8316 | (defvar idlwave-rinfo-map (make-sparse-keymap)) | 8316 | (defvar idlwave-rinfo-map (make-sparse-keymap)) |
| 8317 | (define-key idlwave-rinfo-mouse-map | 8317 | (define-key idlwave-rinfo-mouse-map |
| 8318 | (if (featurep 'xemacs) [button2] [mouse-2]) | 8318 | (if (featurep 'xemacs) [button2] [mouse-2]) |
| 8319 | 'idlwave-mouse-active-rinfo) | 8319 | 'idlwave-mouse-active-rinfo) |
| 8320 | (define-key idlwave-rinfo-mouse-map | 8320 | (define-key idlwave-rinfo-mouse-map |
| 8321 | (if (featurep 'xemacs) [(shift button2)] [(shift mouse-2)]) | 8321 | (if (featurep 'xemacs) [(shift button2)] [(shift mouse-2)]) |
| 8322 | 'idlwave-mouse-active-rinfo-shift) | 8322 | 'idlwave-mouse-active-rinfo-shift) |
| 8323 | (define-key idlwave-rinfo-mouse-map | 8323 | (define-key idlwave-rinfo-mouse-map |
| 8324 | (if (featurep 'xemacs) [button3] [mouse-3]) | 8324 | (if (featurep 'xemacs) [button3] [mouse-3]) |
| 8325 | 'idlwave-mouse-active-rinfo-right) | 8325 | 'idlwave-mouse-active-rinfo-right) |
| 8326 | (define-key idlwave-rinfo-mouse-map " " 'idlwave-active-rinfo-space) | 8326 | (define-key idlwave-rinfo-mouse-map " " 'idlwave-active-rinfo-space) |
| @@ -8346,7 +8346,7 @@ If we do not know about MODULE, just return KEYWORD literally." | |||
| 8346 | (let* ((initial-class (or initial-class class)) | 8346 | (let* ((initial-class (or initial-class class)) |
| 8347 | (entry (or (idlwave-best-rinfo-assq name type class | 8347 | (entry (or (idlwave-best-rinfo-assq name type class |
| 8348 | (idlwave-routines)) | 8348 | (idlwave-routines)) |
| 8349 | (idlwave-rinfo-assq name type class | 8349 | (idlwave-rinfo-assq name type class |
| 8350 | idlwave-unresolved-routines))) | 8350 | idlwave-unresolved-routines))) |
| 8351 | (name (or (car entry) name)) | 8351 | (name (or (car entry) name)) |
| 8352 | (class (or (nth 2 entry) class)) | 8352 | (class (or (nth 2 entry) class)) |
| @@ -8371,7 +8371,7 @@ If we do not know about MODULE, just return KEYWORD literally." | |||
| 8371 | (km-prop (if (featurep 'xemacs) 'keymap 'local-map)) | 8371 | (km-prop (if (featurep 'xemacs) 'keymap 'local-map)) |
| 8372 | (face 'idlwave-help-link) | 8372 | (face 'idlwave-help-link) |
| 8373 | beg props win cnt total) | 8373 | beg props win cnt total) |
| 8374 | ;; Fix keywords, but don't add chained super-classes, since these | 8374 | ;; Fix keywords, but don't add chained super-classes, since these |
| 8375 | ;; are shown separately for that super-class | 8375 | ;; are shown separately for that super-class |
| 8376 | (setq keywords (idlwave-fix-keywords name type class keywords)) | 8376 | (setq keywords (idlwave-fix-keywords name type class keywords)) |
| 8377 | (cond | 8377 | (cond |
| @@ -8413,7 +8413,7 @@ If we do not know about MODULE, just return KEYWORD literally." | |||
| 8413 | km-prop idlwave-rinfo-mouse-map | 8413 | km-prop idlwave-rinfo-mouse-map |
| 8414 | 'help-echo help-echo-use | 8414 | 'help-echo help-echo-use |
| 8415 | 'data (cons 'usage data))) | 8415 | 'data (cons 'usage data))) |
| 8416 | (if html-file (setq props (append (list 'face face 'link html-file) | 8416 | (if html-file (setq props (append (list 'face face 'link html-file) |
| 8417 | props))) | 8417 | props))) |
| 8418 | (insert "Usage: ") | 8418 | (insert "Usage: ") |
| 8419 | (setq beg (point)) | 8419 | (setq beg (point)) |
| @@ -8422,14 +8422,14 @@ If we do not know about MODULE, just return KEYWORD literally." | |||
| 8422 | (format calling-seq name name name name)) | 8422 | (format calling-seq name name name name)) |
| 8423 | "\n") | 8423 | "\n") |
| 8424 | (add-text-properties beg (point) props) | 8424 | (add-text-properties beg (point) props) |
| 8425 | 8425 | ||
| 8426 | (insert "Keywords:") | 8426 | (insert "Keywords:") |
| 8427 | (if (null keywords) | 8427 | (if (null keywords) |
| 8428 | (insert " No keywords accepted.") | 8428 | (insert " No keywords accepted.") |
| 8429 | (setq col 9) | 8429 | (setq col 9) |
| 8430 | (mapcar | 8430 | (mapcar |
| 8431 | (lambda (x) | 8431 | (lambda (x) |
| 8432 | (if (>= (+ col 1 (length (car x))) | 8432 | (if (>= (+ col 1 (length (car x))) |
| 8433 | (window-width)) | 8433 | (window-width)) |
| 8434 | (progn | 8434 | (progn |
| 8435 | (insert "\n ") | 8435 | (insert "\n ") |
| @@ -8447,7 +8447,7 @@ If we do not know about MODULE, just return KEYWORD literally." | |||
| 8447 | (add-text-properties beg (point) props) | 8447 | (add-text-properties beg (point) props) |
| 8448 | (setq col (+ col 1 (length (car x))))) | 8448 | (setq col (+ col 1 (length (car x))))) |
| 8449 | keywords)) | 8449 | keywords)) |
| 8450 | 8450 | ||
| 8451 | (setq cnt 1 total (length all)) | 8451 | (setq cnt 1 total (length all)) |
| 8452 | ;; Here entry is (key file (list of type-conses)) | 8452 | ;; Here entry is (key file (list of type-conses)) |
| 8453 | (while (setq entry (pop all)) | 8453 | (while (setq entry (pop all)) |
| @@ -8460,7 +8460,7 @@ If we do not know about MODULE, just return KEYWORD literally." | |||
| 8460 | (cdr (car (nth 2 entry)))) | 8460 | (cdr (car (nth 2 entry)))) |
| 8461 | 'data (cons 'source data))) | 8461 | 'data (cons 'source data))) |
| 8462 | (idlwave-insert-source-location | 8462 | (idlwave-insert-source-location |
| 8463 | (format "\n%-8s %s" | 8463 | (format "\n%-8s %s" |
| 8464 | (if (equal cnt 1) | 8464 | (if (equal cnt 1) |
| 8465 | (if (> total 1) "Sources:" "Source:") | 8465 | (if (> total 1) "Sources:" "Source:") |
| 8466 | "") | 8466 | "") |
| @@ -8469,7 +8469,7 @@ If we do not know about MODULE, just return KEYWORD literally." | |||
| 8469 | (incf cnt) | 8469 | (incf cnt) |
| 8470 | (when (and all (> cnt idlwave-rinfo-max-source-lines)) | 8470 | (when (and all (> cnt idlwave-rinfo-max-source-lines)) |
| 8471 | ;; No more source lines, please | 8471 | ;; No more source lines, please |
| 8472 | (insert (format | 8472 | (insert (format |
| 8473 | "\n Source information truncated to %d entries." | 8473 | "\n Source information truncated to %d entries." |
| 8474 | idlwave-rinfo-max-source-lines)) | 8474 | idlwave-rinfo-max-source-lines)) |
| 8475 | (setq all nil))) | 8475 | (setq all nil))) |
| @@ -8483,7 +8483,7 @@ If we do not know about MODULE, just return KEYWORD literally." | |||
| 8483 | (unwind-protect | 8483 | (unwind-protect |
| 8484 | (progn | 8484 | (progn |
| 8485 | (select-window win) | 8485 | (select-window win) |
| 8486 | (enlarge-window (- (/ (frame-height) 2) | 8486 | (enlarge-window (- (/ (frame-height) 2) |
| 8487 | (window-height))) | 8487 | (window-height))) |
| 8488 | (shrink-window-if-larger-than-buffer)) | 8488 | (shrink-window-if-larger-than-buffer)) |
| 8489 | (select-window ww))))))))) | 8489 | (select-window ww))))))))) |
| @@ -8520,9 +8520,9 @@ it." | |||
| 8520 | ((and (not file) shell-flag) | 8520 | ((and (not file) shell-flag) |
| 8521 | (insert "Unresolved")) | 8521 | (insert "Unresolved")) |
| 8522 | 8522 | ||
| 8523 | ((null file) | 8523 | ((null file) |
| 8524 | (insert "ERROR")) | 8524 | (insert "ERROR")) |
| 8525 | 8525 | ||
| 8526 | ((idlwave-syslib-p file) | 8526 | ((idlwave-syslib-p file) |
| 8527 | (if (string-match "obsolete" (file-name-directory file)) | 8527 | (if (string-match "obsolete" (file-name-directory file)) |
| 8528 | (insert "Obsolete ") | 8528 | (insert "Obsolete ") |
| @@ -8536,7 +8536,7 @@ it." | |||
| 8536 | ;; Old special syntax: a matching regexp | 8536 | ;; Old special syntax: a matching regexp |
| 8537 | ((setq special (idlwave-special-lib-test file)) | 8537 | ((setq special (idlwave-special-lib-test file)) |
| 8538 | (insert (format "%-10s" special))) | 8538 | (insert (format "%-10s" special))) |
| 8539 | 8539 | ||
| 8540 | ;; Catch-all with file | 8540 | ;; Catch-all with file |
| 8541 | ((idlwave-lib-p file) (insert "Library ")) | 8541 | ((idlwave-lib-p file) (insert "Library ")) |
| 8542 | 8542 | ||
| @@ -8551,7 +8551,7 @@ it." | |||
| 8551 | (if shell-flag "S" "-") | 8551 | (if shell-flag "S" "-") |
| 8552 | (if buffer-flag "B" "-") | 8552 | (if buffer-flag "B" "-") |
| 8553 | "] "))) | 8553 | "] "))) |
| 8554 | (when (> ndupl 1) | 8554 | (when (> ndupl 1) |
| 8555 | (setq beg (point)) | 8555 | (setq beg (point)) |
| 8556 | (insert (format "(%dx) " ndupl)) | 8556 | (insert (format "(%dx) " ndupl)) |
| 8557 | (add-text-properties beg (point) (list 'face 'bold))) | 8557 | (add-text-properties beg (point) (list 'face 'bold))) |
| @@ -8575,7 +8575,7 @@ Return the name of the special lib if there is a match." | |||
| 8575 | alist nil))) | 8575 | alist nil))) |
| 8576 | rtn) | 8576 | rtn) |
| 8577 | (t nil)))) | 8577 | (t nil)))) |
| 8578 | 8578 | ||
| 8579 | (defun idlwave-mouse-active-rinfo-right (ev) | 8579 | (defun idlwave-mouse-active-rinfo-right (ev) |
| 8580 | (interactive "e") | 8580 | (interactive "e") |
| 8581 | (idlwave-mouse-active-rinfo ev 'right)) | 8581 | (idlwave-mouse-active-rinfo ev 'right)) |
| @@ -8594,7 +8594,7 @@ Optional args RIGHT and SHIFT indicate, if mouse-3 was used, and if SHIFT | |||
| 8594 | was pressed." | 8594 | was pressed." |
| 8595 | (interactive "e") | 8595 | (interactive "e") |
| 8596 | (if ev (mouse-set-point ev)) | 8596 | (if ev (mouse-set-point ev)) |
| 8597 | (let (data id name type class buf bufwin source link keyword | 8597 | (let (data id name type class buf bufwin source link keyword |
| 8598 | word initial-class) | 8598 | word initial-class) |
| 8599 | (setq data (get-text-property (point) 'data) | 8599 | (setq data (get-text-property (point) 'data) |
| 8600 | source (get-text-property (point) 'source) | 8600 | source (get-text-property (point) 'source) |
| @@ -8609,9 +8609,9 @@ was pressed." | |||
| 8609 | 8609 | ||
| 8610 | (cond ((eq id 'class) ; Switch class being displayed | 8610 | (cond ((eq id 'class) ; Switch class being displayed |
| 8611 | (if (window-live-p bufwin) (select-window bufwin)) | 8611 | (if (window-live-p bufwin) (select-window bufwin)) |
| 8612 | (idlwave-display-calling-sequence | 8612 | (idlwave-display-calling-sequence |
| 8613 | (idlwave-sintern-method name) | 8613 | (idlwave-sintern-method name) |
| 8614 | type (idlwave-sintern-class word) | 8614 | type (idlwave-sintern-class word) |
| 8615 | initial-class)) | 8615 | initial-class)) |
| 8616 | ((eq id 'usage) ; Online help on this routine | 8616 | ((eq id 'usage) ; Online help on this routine |
| 8617 | (idlwave-online-help link name type class)) | 8617 | (idlwave-online-help link name type class)) |
| @@ -8652,9 +8652,9 @@ was pressed." | |||
| 8652 | (setq bwin (get-buffer-window buffer))) | 8652 | (setq bwin (get-buffer-window buffer))) |
| 8653 | (if (eq (preceding-char) ?/) | 8653 | (if (eq (preceding-char) ?/) |
| 8654 | (insert keyword) | 8654 | (insert keyword) |
| 8655 | (unless (save-excursion | 8655 | (unless (save-excursion |
| 8656 | (re-search-backward | 8656 | (re-search-backward |
| 8657 | "[(,][ \t]*\\(\\$[ \t]*\\(;.*\\)?\n\\)?[ \t]*\\=" | 8657 | "[(,][ \t]*\\(\\$[ \t]*\\(;.*\\)?\n\\)?[ \t]*\\=" |
| 8658 | (min (- (point) 100) (point-min)) t)) | 8658 | (min (- (point) 100) (point-min)) t)) |
| 8659 | (insert ", ")) | 8659 | (insert ", ")) |
| 8660 | (if shift (insert "/")) | 8660 | (if shift (insert "/")) |
| @@ -8706,7 +8706,7 @@ the load path in order to find a definition. The output of this | |||
| 8706 | command can be used to detect possible name clashes during this process." | 8706 | command can be used to detect possible name clashes during this process." |
| 8707 | (idlwave-routines) ; Make sure everything is loaded. | 8707 | (idlwave-routines) ; Make sure everything is loaded. |
| 8708 | (unless (or idlwave-user-catalog-routines idlwave-library-catalog-routines) | 8708 | (unless (or idlwave-user-catalog-routines idlwave-library-catalog-routines) |
| 8709 | (or (y-or-n-p | 8709 | (or (y-or-n-p |
| 8710 | "You don't have any user or library catalogs. Continue anyway? ") | 8710 | "You don't have any user or library catalogs. Continue anyway? ") |
| 8711 | (error "Abort"))) | 8711 | (error "Abort"))) |
| 8712 | (let* ((routines (append idlwave-system-routines | 8712 | (let* ((routines (append idlwave-system-routines |
| @@ -8719,7 +8719,7 @@ command can be used to detect possible name clashes during this process." | |||
| 8719 | (keymap (make-sparse-keymap)) | 8719 | (keymap (make-sparse-keymap)) |
| 8720 | (props (list 'mouse-face 'highlight | 8720 | (props (list 'mouse-face 'highlight |
| 8721 | km-prop keymap | 8721 | km-prop keymap |
| 8722 | 'help-echo "Mouse2: Find source")) | 8722 | 'help-echo "Mouse2: Find source")) |
| 8723 | (nroutines (length (or special-routines routines))) | 8723 | (nroutines (length (or special-routines routines))) |
| 8724 | (step (/ nroutines 100)) | 8724 | (step (/ nroutines 100)) |
| 8725 | (n 0) | 8725 | (n 0) |
| @@ -8742,13 +8742,13 @@ command can be used to detect possible name clashes during this process." | |||
| 8742 | (message "Sorting routines...done") | 8742 | (message "Sorting routines...done") |
| 8743 | 8743 | ||
| 8744 | (define-key keymap (if (featurep 'xemacs) [(button2)] [(mouse-2)]) | 8744 | (define-key keymap (if (featurep 'xemacs) [(button2)] [(mouse-2)]) |
| 8745 | (lambda (ev) | 8745 | (lambda (ev) |
| 8746 | (interactive "e") | 8746 | (interactive "e") |
| 8747 | (mouse-set-point ev) | 8747 | (mouse-set-point ev) |
| 8748 | (apply 'idlwave-do-find-module | 8748 | (apply 'idlwave-do-find-module |
| 8749 | (get-text-property (point) 'find-args)))) | 8749 | (get-text-property (point) 'find-args)))) |
| 8750 | (define-key keymap [(return)] | 8750 | (define-key keymap [(return)] |
| 8751 | (lambda () | 8751 | (lambda () |
| 8752 | (interactive) | 8752 | (interactive) |
| 8753 | (apply 'idlwave-do-find-module | 8753 | (apply 'idlwave-do-find-module |
| 8754 | (get-text-property (point) 'find-args)))) | 8754 | (get-text-property (point) 'find-args)))) |
| @@ -8774,13 +8774,13 @@ command can be used to detect possible name clashes during this process." | |||
| 8774 | (> (idlwave-count-memq 'buffer (nth 2 (car dtwins))) 1)) | 8774 | (> (idlwave-count-memq 'buffer (nth 2 (car dtwins))) 1)) |
| 8775 | (incf cnt) | 8775 | (incf cnt) |
| 8776 | (insert (format "\n%s%s" | 8776 | (insert (format "\n%s%s" |
| 8777 | (idlwave-make-full-name (nth 2 routine) | 8777 | (idlwave-make-full-name (nth 2 routine) |
| 8778 | (car routine)) | 8778 | (car routine)) |
| 8779 | (if (eq (nth 1 routine) 'fun) "()" ""))) | 8779 | (if (eq (nth 1 routine) 'fun) "()" ""))) |
| 8780 | (while (setq twin (pop dtwins)) | 8780 | (while (setq twin (pop dtwins)) |
| 8781 | (setq props1 (append (list 'find-args | 8781 | (setq props1 (append (list 'find-args |
| 8782 | (list (nth 0 routine) | 8782 | (list (nth 0 routine) |
| 8783 | (nth 1 routine) | 8783 | (nth 1 routine) |
| 8784 | (nth 2 routine))) | 8784 | (nth 2 routine))) |
| 8785 | props)) | 8785 | props)) |
| 8786 | (idlwave-insert-source-location "\n - " twin props1)))) | 8786 | (idlwave-insert-source-location "\n - " twin props1)))) |
| @@ -8803,7 +8803,7 @@ command can be used to detect possible name clashes during this process." | |||
| 8803 | (or (not (stringp sfile)) | 8803 | (or (not (stringp sfile)) |
| 8804 | (not (string-match "\\S-" sfile)))) | 8804 | (not (string-match "\\S-" sfile)))) |
| 8805 | (setq stype 'unresolved)) | 8805 | (setq stype 'unresolved)) |
| 8806 | (princ (format " %-10s %s\n" | 8806 | (princ (format " %-10s %s\n" |
| 8807 | stype | 8807 | stype |
| 8808 | (if sfile sfile "No source code available"))))) | 8808 | (if sfile sfile "No source code available"))))) |
| 8809 | 8809 | ||
| @@ -8822,20 +8822,20 @@ ENTRY will also be returned, as the first item of this list." | |||
| 8822 | (eq type (nth 1 candidate)) | 8822 | (eq type (nth 1 candidate)) |
| 8823 | (eq class (nth 2 candidate))) | 8823 | (eq class (nth 2 candidate))) |
| 8824 | (push candidate twins))) | 8824 | (push candidate twins))) |
| 8825 | (if (setq candidate (idlwave-rinfo-assq name type class | 8825 | (if (setq candidate (idlwave-rinfo-assq name type class |
| 8826 | idlwave-unresolved-routines)) | 8826 | idlwave-unresolved-routines)) |
| 8827 | (push candidate twins)) | 8827 | (push candidate twins)) |
| 8828 | (cons entry (nreverse twins)))) | 8828 | (cons entry (nreverse twins)))) |
| 8829 | 8829 | ||
| 8830 | (defun idlwave-study-twins (entries) | 8830 | (defun idlwave-study-twins (entries) |
| 8831 | "Return dangerous twins of first entry in ENTRIES. | 8831 | "Return dangerous twins of first entry in ENTRIES. |
| 8832 | Dangerous twins are routines with same name, but in different files on | 8832 | Dangerous twins are routines with same name, but in different files on |
| 8833 | the load path. If a file is in the system library and has an entry in | 8833 | the load path. If a file is in the system library and has an entry in |
| 8834 | the `idlwave-system-routines' list, we omit the latter as | 8834 | the `idlwave-system-routines' list, we omit the latter as |
| 8835 | non-dangerous because many IDL routines are implemented as library | 8835 | non-dangerous because many IDL routines are implemented as library |
| 8836 | routines, and may have been scanned." | 8836 | routines, and may have been scanned." |
| 8837 | (let* ((entry (car entries)) | 8837 | (let* ((entry (car entries)) |
| 8838 | (name (car entry)) ; | 8838 | (name (car entry)) ; |
| 8839 | (type (nth 1 entry)) ; Must be bound for | 8839 | (type (nth 1 entry)) ; Must be bound for |
| 8840 | (class (nth 2 entry)) ; idlwave-routine-twin-compare | 8840 | (class (nth 2 entry)) ; idlwave-routine-twin-compare |
| 8841 | (cnt 0) | 8841 | (cnt 0) |
| @@ -8853,23 +8853,23 @@ routines, and may have been scanned." | |||
| 8853 | (t 'unresolved))) | 8853 | (t 'unresolved))) |
| 8854 | 8854 | ||
| 8855 | ;; Check for an entry in the system library | 8855 | ;; Check for an entry in the system library |
| 8856 | (if (and file | 8856 | (if (and file |
| 8857 | (not syslibp) | 8857 | (not syslibp) |
| 8858 | (idlwave-syslib-p file)) | 8858 | (idlwave-syslib-p file)) |
| 8859 | (setq syslibp t)) | 8859 | (setq syslibp t)) |
| 8860 | 8860 | ||
| 8861 | ;; If there's more than one matching entry for the same file, just | 8861 | ;; If there's more than one matching entry for the same file, just |
| 8862 | ;; append the type-cons to the type list. | 8862 | ;; append the type-cons to the type list. |
| 8863 | (if (setq entry (assoc key alist)) | 8863 | (if (setq entry (assoc key alist)) |
| 8864 | (push type-cons (nth 2 entry)) | 8864 | (push type-cons (nth 2 entry)) |
| 8865 | (push (list key file (list type-cons)) alist))) | 8865 | (push (list key file (list type-cons)) alist))) |
| 8866 | 8866 | ||
| 8867 | (setq alist (nreverse alist)) | 8867 | (setq alist (nreverse alist)) |
| 8868 | 8868 | ||
| 8869 | (when syslibp | 8869 | (when syslibp |
| 8870 | ;; File is in system *library* - remove any 'system entry | 8870 | ;; File is in system *library* - remove any 'system entry |
| 8871 | (setq alist (delq (assq 'system alist) alist))) | 8871 | (setq alist (delq (assq 'system alist) alist))) |
| 8872 | 8872 | ||
| 8873 | ;; If 'system remains and we've scanned the syslib, it's a builtin | 8873 | ;; If 'system remains and we've scanned the syslib, it's a builtin |
| 8874 | ;; (rather than a !DIR/lib/.pro file bundled as source). | 8874 | ;; (rather than a !DIR/lib/.pro file bundled as source). |
| 8875 | (when (and (idlwave-syslib-scanned-p) | 8875 | (when (and (idlwave-syslib-scanned-p) |
| @@ -8905,7 +8905,7 @@ compares twins on the basis of their file names and path locations." | |||
| 8905 | ((not (eq type (nth 1 b))) | 8905 | ((not (eq type (nth 1 b))) |
| 8906 | ;; Type decides | 8906 | ;; Type decides |
| 8907 | (< (if (eq type 'fun) 1 0) (if (eq (nth 1 b) 'fun) 1 0))) | 8907 | (< (if (eq type 'fun) 1 0) (if (eq (nth 1 b) 'fun) 1 0))) |
| 8908 | (t | 8908 | (t |
| 8909 | ;; A and B are twins - so the decision is more complicated. | 8909 | ;; A and B are twins - so the decision is more complicated. |
| 8910 | ;; Call twin-compare with the proper arguments. | 8910 | ;; Call twin-compare with the proper arguments. |
| 8911 | (idlwave-routine-entry-compare-twins a b))))) | 8911 | (idlwave-routine-entry-compare-twins a b))))) |
| @@ -8957,7 +8957,7 @@ This expects NAME TYPE CLASS to be bound to the right values." | |||
| 8957 | (tpath-alist (idlwave-true-path-alist)) | 8957 | (tpath-alist (idlwave-true-path-alist)) |
| 8958 | (apathp (and (stringp akey) | 8958 | (apathp (and (stringp akey) |
| 8959 | (assoc (file-name-directory akey) tpath-alist))) | 8959 | (assoc (file-name-directory akey) tpath-alist))) |
| 8960 | (bpathp (and (stringp bkey) | 8960 | (bpathp (and (stringp bkey) |
| 8961 | (assoc (file-name-directory bkey) tpath-alist))) | 8961 | (assoc (file-name-directory bkey) tpath-alist))) |
| 8962 | ;; How early on search path? High number means early since we | 8962 | ;; How early on search path? High number means early since we |
| 8963 | ;; measure the tail of the path list | 8963 | ;; measure the tail of the path list |
| @@ -8993,7 +8993,7 @@ This expects NAME TYPE CLASS to be bound to the right values." | |||
| 8993 | (t nil)))) ; Default | 8993 | (t nil)))) ; Default |
| 8994 | 8994 | ||
| 8995 | (defun idlwave-routine-source-file (source) | 8995 | (defun idlwave-routine-source-file (source) |
| 8996 | (if (nth 2 source) | 8996 | (if (nth 2 source) |
| 8997 | (expand-file-name (nth 1 source) (nth 2 source)) | 8997 | (expand-file-name (nth 1 source) (nth 2 source)) |
| 8998 | (nth 1 source))) | 8998 | (nth 1 source))) |
| 8999 | 8999 | ||
| @@ -9083,7 +9083,7 @@ Assumes that point is at the beginning of the unit as found by | |||
| 9083 | (forward-sexp 2) | 9083 | (forward-sexp 2) |
| 9084 | (forward-sexp -1) | 9084 | (forward-sexp -1) |
| 9085 | (let ((begin (point))) | 9085 | (let ((begin (point))) |
| 9086 | (re-search-forward | 9086 | (re-search-forward |
| 9087 | "[a-zA-Z_][a-zA-Z0-9$_]+\\(::[a-zA-Z_][a-zA-Z0-9$_]+\\)?") | 9087 | "[a-zA-Z_][a-zA-Z0-9$_]+\\(::[a-zA-Z_][a-zA-Z0-9$_]+\\)?") |
| 9088 | (if (fboundp 'buffer-substring-no-properties) | 9088 | (if (fboundp 'buffer-substring-no-properties) |
| 9089 | (buffer-substring-no-properties begin (point)) | 9089 | (buffer-substring-no-properties begin (point)) |
| @@ -9123,7 +9123,7 @@ Assumes that point is at the beginning of the unit as found by | |||
| 9123 | (start-process "idldeclient" nil | 9123 | (start-process "idldeclient" nil |
| 9124 | idlwave-shell-explicit-file-name "-c" "-e" | 9124 | idlwave-shell-explicit-file-name "-c" "-e" |
| 9125 | (buffer-file-name))) | 9125 | (buffer-file-name))) |
| 9126 | 9126 | ||
| 9127 | (defvar idlwave-help-use-assistant) | 9127 | (defvar idlwave-help-use-assistant) |
| 9128 | (defun idlwave-launch-idlhelp () | 9128 | (defun idlwave-launch-idlhelp () |
| 9129 | "Start the IDLhelp application." | 9129 | "Start the IDLhelp application." |
| @@ -9131,7 +9131,7 @@ Assumes that point is at the beginning of the unit as found by | |||
| 9131 | (if idlwave-help-use-assistant | 9131 | (if idlwave-help-use-assistant |
| 9132 | (idlwave-help-assistant-raise) | 9132 | (idlwave-help-assistant-raise) |
| 9133 | (start-process "idlhelp" nil idlwave-help-application))) | 9133 | (start-process "idlhelp" nil idlwave-help-application))) |
| 9134 | 9134 | ||
| 9135 | ;; Menus - using easymenu.el | 9135 | ;; Menus - using easymenu.el |
| 9136 | (defvar idlwave-mode-menu-def | 9136 | (defvar idlwave-mode-menu-def |
| 9137 | `("IDLWAVE" | 9137 | `("IDLWAVE" |
| @@ -9150,7 +9150,7 @@ Assumes that point is at the beginning of the unit as found by | |||
| 9150 | ["Block" idlwave-mark-block t] | 9150 | ["Block" idlwave-mark-block t] |
| 9151 | ["Header" idlwave-mark-doclib t]) | 9151 | ["Header" idlwave-mark-doclib t]) |
| 9152 | ("Format" | 9152 | ("Format" |
| 9153 | ["Indent Entire Statement" idlwave-indent-statement | 9153 | ["Indent Entire Statement" idlwave-indent-statement |
| 9154 | :active t :keys "C-u \\[indent-for-tab-command]" ] | 9154 | :active t :keys "C-u \\[indent-for-tab-command]" ] |
| 9155 | ["Indent Subprogram" idlwave-indent-subprogram t] | 9155 | ["Indent Subprogram" idlwave-indent-subprogram t] |
| 9156 | ["(Un)Comment Region" idlwave-toggle-comment-region t] | 9156 | ["(Un)Comment Region" idlwave-toggle-comment-region t] |
| @@ -9220,7 +9220,7 @@ Assumes that point is at the beginning of the unit as found by | |||
| 9220 | ("Customize" | 9220 | ("Customize" |
| 9221 | ["Browse IDLWAVE Group" idlwave-customize t] | 9221 | ["Browse IDLWAVE Group" idlwave-customize t] |
| 9222 | "--" | 9222 | "--" |
| 9223 | ["Build Full Customize Menu" idlwave-create-customize-menu | 9223 | ["Build Full Customize Menu" idlwave-create-customize-menu |
| 9224 | (fboundp 'customize-menu-create)]) | 9224 | (fboundp 'customize-menu-create)]) |
| 9225 | ("Documentation" | 9225 | ("Documentation" |
| 9226 | ["Describe Mode" describe-mode t] | 9226 | ["Describe Mode" describe-mode t] |
| @@ -9237,22 +9237,22 @@ Assumes that point is at the beginning of the unit as found by | |||
| 9237 | '("Debug" | 9237 | '("Debug" |
| 9238 | ["Start IDL shell" idlwave-shell t] | 9238 | ["Start IDL shell" idlwave-shell t] |
| 9239 | ["Save and .RUN buffer" idlwave-shell-save-and-run | 9239 | ["Save and .RUN buffer" idlwave-shell-save-and-run |
| 9240 | (and (boundp 'idlwave-shell-automatic-start) | 9240 | (and (boundp 'idlwave-shell-automatic-start) |
| 9241 | idlwave-shell-automatic-start)])) | 9241 | idlwave-shell-automatic-start)])) |
| 9242 | 9242 | ||
| 9243 | (if (or (featurep 'easymenu) (load "easymenu" t)) | 9243 | (if (or (featurep 'easymenu) (load "easymenu" t)) |
| 9244 | (progn | 9244 | (progn |
| 9245 | (easy-menu-define idlwave-mode-menu idlwave-mode-map | 9245 | (easy-menu-define idlwave-mode-menu idlwave-mode-map |
| 9246 | "IDL and WAVE CL editing menu" | 9246 | "IDL and WAVE CL editing menu" |
| 9247 | idlwave-mode-menu-def) | 9247 | idlwave-mode-menu-def) |
| 9248 | (easy-menu-define idlwave-mode-debug-menu idlwave-mode-map | 9248 | (easy-menu-define idlwave-mode-debug-menu idlwave-mode-map |
| 9249 | "IDL and WAVE CL editing menu" | 9249 | "IDL and WAVE CL editing menu" |
| 9250 | idlwave-mode-debug-menu-def))) | 9250 | idlwave-mode-debug-menu-def))) |
| 9251 | 9251 | ||
| 9252 | (defun idlwave-customize () | 9252 | (defun idlwave-customize () |
| 9253 | "Call the customize function with idlwave as argument." | 9253 | "Call the customize function with idlwave as argument." |
| 9254 | (interactive) | 9254 | (interactive) |
| 9255 | ;; Try to load the code for the shell, so that we can customize it | 9255 | ;; Try to load the code for the shell, so that we can customize it |
| 9256 | ;; as well. | 9256 | ;; as well. |
| 9257 | (or (featurep 'idlw-shell) | 9257 | (or (featurep 'idlw-shell) |
| 9258 | (load "idlw-shell" t)) | 9258 | (load "idlw-shell" t)) |
| @@ -9263,11 +9263,11 @@ Assumes that point is at the beginning of the unit as found by | |||
| 9263 | (interactive) | 9263 | (interactive) |
| 9264 | (if (fboundp 'customize-menu-create) | 9264 | (if (fboundp 'customize-menu-create) |
| 9265 | (progn | 9265 | (progn |
| 9266 | ;; Try to load the code for the shell, so that we can customize it | 9266 | ;; Try to load the code for the shell, so that we can customize it |
| 9267 | ;; as well. | 9267 | ;; as well. |
| 9268 | (or (featurep 'idlw-shell) | 9268 | (or (featurep 'idlw-shell) |
| 9269 | (load "idlw-shell" t)) | 9269 | (load "idlw-shell" t)) |
| 9270 | (easy-menu-change | 9270 | (easy-menu-change |
| 9271 | '("IDLWAVE") "Customize" | 9271 | '("IDLWAVE") "Customize" |
| 9272 | `(["Browse IDLWAVE group" idlwave-customize t] | 9272 | `(["Browse IDLWAVE group" idlwave-customize t] |
| 9273 | "--" | 9273 | "--" |
| @@ -9315,7 +9315,7 @@ This function was written since `list-abbrevs' looks terrible for IDLWAVE mode." | |||
| 9315 | (let ((table (symbol-value 'idlwave-mode-abbrev-table)) | 9315 | (let ((table (symbol-value 'idlwave-mode-abbrev-table)) |
| 9316 | abbrevs | 9316 | abbrevs |
| 9317 | str rpl func fmt (len-str 0) (len-rpl 0)) | 9317 | str rpl func fmt (len-str 0) (len-rpl 0)) |
| 9318 | (mapatoms | 9318 | (mapatoms |
| 9319 | (lambda (sym) | 9319 | (lambda (sym) |
| 9320 | (if (symbol-value sym) | 9320 | (if (symbol-value sym) |
| 9321 | (progn | 9321 | (progn |
| @@ -9341,7 +9341,7 @@ This function was written since `list-abbrevs' looks terrible for IDLWAVE mode." | |||
| 9341 | (with-output-to-temp-buffer "*Help*" | 9341 | (with-output-to-temp-buffer "*Help*" |
| 9342 | (if arg | 9342 | (if arg |
| 9343 | (progn | 9343 | (progn |
| 9344 | (princ "Abbreviations and Actions in IDLWAVE-Mode\n") | 9344 | (princ "Abbreviations and Actions in IDLWAVE-Mode\n") |
| 9345 | (princ "=========================================\n\n") | 9345 | (princ "=========================================\n\n") |
| 9346 | (princ (format fmt "KEY" "REPLACE" "HOOK")) | 9346 | (princ (format fmt "KEY" "REPLACE" "HOOK")) |
| 9347 | (princ (format fmt "---" "-------" "----"))) | 9347 | (princ (format fmt "---" "-------" "----"))) |
diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el index 109455e9e61..c7341a9f871 100644 --- a/lisp/progmodes/make-mode.el +++ b/lisp/progmodes/make-mode.el | |||
| @@ -836,8 +836,8 @@ Makefile mode can be configured by modifying the following variables: | |||
| 836 | nil nil | 836 | nil nil |
| 837 | ((?$ . ".")) | 837 | ((?$ . ".")) |
| 838 | backward-paragraph | 838 | backward-paragraph |
| 839 | (font-lock-syntactic-keywords . makefile-font-lock-syntactic-keywords) | 839 | (font-lock-syntactic-keywords |
| 840 | (font-lock-support-mode))) ; JIT breaks on long series of continuation lines. | 840 | . makefile-font-lock-syntactic-keywords))) |
| 841 | 841 | ||
| 842 | ;; Add-log. | 842 | ;; Add-log. |
| 843 | (make-local-variable 'add-log-current-defun-function) | 843 | (make-local-variable 'add-log-current-defun-function) |
diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el index 14b47475eb1..c29a259c3a6 100644 --- a/lisp/progmodes/prolog.el +++ b/lisp/progmodes/prolog.el | |||
| @@ -41,27 +41,27 @@ | |||
| 41 | 41 | ||
| 42 | 42 | ||
| 43 | (defcustom prolog-program-name | 43 | (defcustom prolog-program-name |
| 44 | (let ((names '("prolog" "gprolog"))) | 44 | (let ((names '("prolog" "gprolog" "swipl"))) |
| 45 | (while (and names | 45 | (while (and names |
| 46 | (not (executable-find (car names)))) | 46 | (not (executable-find (car names)))) |
| 47 | (setq names (cdr names))) | 47 | (setq names (cdr names))) |
| 48 | (or (car names) "prolog")) | 48 | (or (car names) "prolog")) |
| 49 | "*Program name for invoking an inferior Prolog with `run-prolog'." | 49 | "Program name for invoking an inferior Prolog with `run-prolog'." |
| 50 | :type 'string | 50 | :type 'string |
| 51 | :group 'prolog) | 51 | :group 'prolog) |
| 52 | 52 | ||
| 53 | (defcustom prolog-consult-string "reconsult(user).\n" | 53 | (defcustom prolog-consult-string "reconsult(user).\n" |
| 54 | "*(Re)Consult mode (for C-Prolog and Quintus Prolog). " | 54 | "(Re)Consult mode (for C-Prolog and Quintus Prolog). " |
| 55 | :type 'string | 55 | :type 'string |
| 56 | :group 'prolog) | 56 | :group 'prolog) |
| 57 | 57 | ||
| 58 | (defcustom prolog-compile-string "compile(user).\n" | 58 | (defcustom prolog-compile-string "compile(user).\n" |
| 59 | "*Compile mode (for Quintus Prolog)." | 59 | "Compile mode (for Quintus Prolog)." |
| 60 | :type 'string | 60 | :type 'string |
| 61 | :group 'prolog) | 61 | :group 'prolog) |
| 62 | 62 | ||
| 63 | (defcustom prolog-eof-string "end_of_file.\n" | 63 | (defcustom prolog-eof-string "end_of_file.\n" |
| 64 | "*String that represents end of file for Prolog. | 64 | "String that represents end of file for Prolog. |
| 65 | When nil, send actual operating system end of file." | 65 | When nil, send actual operating system end of file." |
| 66 | :type 'string | 66 | :type 'string |
| 67 | :group 'prolog) | 67 | :group 'prolog) |
| @@ -121,7 +121,21 @@ When nil, send actual operating system end of file." | |||
| 121 | (defvar prolog-mode-map | 121 | (defvar prolog-mode-map |
| 122 | (let ((map (make-sparse-keymap))) | 122 | (let ((map (make-sparse-keymap))) |
| 123 | (define-key map "\e\C-x" 'prolog-consult-region) | 123 | (define-key map "\e\C-x" 'prolog-consult-region) |
| 124 | (define-key map "\C-c\C-l" 'inferior-prolog-load-file) | ||
| 125 | (define-key map "\C-c\C-z" 'switch-to-prolog) | ||
| 124 | map)) | 126 | map)) |
| 127 | |||
| 128 | (easy-menu-define prolog-mode-menu prolog-mode-map "Menu for Prolog mode." | ||
| 129 | ;; Mostly copied from scheme-mode's menu. | ||
| 130 | ;; Not tremendously useful, but it's a start. | ||
| 131 | '("Prolog" | ||
| 132 | ["Indent line" indent-according-to-mode t] | ||
| 133 | ["Indent region" indent-region t] | ||
| 134 | ["Comment region" comment-region t] | ||
| 135 | ["Uncomment region" uncomment-region t] | ||
| 136 | "--" | ||
| 137 | ["Run interactive Prolog session" run-prolog t] | ||
| 138 | )) | ||
| 125 | 139 | ||
| 126 | ;;;###autoload | 140 | ;;;###autoload |
| 127 | (defun prolog-mode () | 141 | (defun prolog-mode () |
| @@ -138,29 +152,24 @@ if that value is non-nil." | |||
| 138 | (setq major-mode 'prolog-mode) | 152 | (setq major-mode 'prolog-mode) |
| 139 | (setq mode-name "Prolog") | 153 | (setq mode-name "Prolog") |
| 140 | (prolog-mode-variables) | 154 | (prolog-mode-variables) |
| 155 | (set (make-local-variable 'comment-add) 1) | ||
| 141 | ;; font lock | 156 | ;; font lock |
| 142 | (setq font-lock-defaults '(prolog-font-lock-keywords | 157 | (setq font-lock-defaults '(prolog-font-lock-keywords |
| 143 | nil nil nil | 158 | nil nil nil |
| 144 | beginning-of-line)) | 159 | beginning-of-line)) |
| 145 | (run-mode-hooks 'prolog-mode-hook)) | 160 | (run-mode-hooks 'prolog-mode-hook)) |
| 146 | 161 | ||
| 147 | (defun prolog-indent-line (&optional whole-exp) | 162 | (defun prolog-indent-line () |
| 148 | "Indent current line as Prolog code. | 163 | "Indent current line as Prolog code. |
| 149 | With argument, indent any additional lines of the same clause | 164 | With argument, indent any additional lines of the same clause |
| 150 | rigidly along with this one (not yet)." | 165 | rigidly along with this one (not yet)." |
| 151 | (interactive "p") | 166 | (interactive "p") |
| 152 | (let ((indent (prolog-indent-level)) | 167 | (let ((indent (prolog-indent-level)) |
| 153 | (pos (- (point-max) (point))) beg) | 168 | (pos (- (point-max) (point)))) |
| 154 | (beginning-of-line) | 169 | (beginning-of-line) |
| 155 | (setq beg (point)) | 170 | (indent-line-to indent) |
| 156 | (skip-chars-forward " \t") | ||
| 157 | (if (zerop (- indent (current-column))) | ||
| 158 | nil | ||
| 159 | (delete-region beg (point)) | ||
| 160 | (indent-to indent)) | ||
| 161 | (if (> (- (point-max) pos) (point)) | 171 | (if (> (- (point-max) pos) (point)) |
| 162 | (goto-char (- (point-max) pos))) | 172 | (goto-char (- (point-max) pos))))) |
| 163 | )) | ||
| 164 | 173 | ||
| 165 | (defun prolog-indent-level () | 174 | (defun prolog-indent-level () |
| 166 | "Compute Prolog indentation level." | 175 | "Compute Prolog indentation level." |
| @@ -224,6 +233,8 @@ rigidly along with this one (not yet)." | |||
| 224 | (let ((map (make-sparse-keymap))) | 233 | (let ((map (make-sparse-keymap))) |
| 225 | ;; This map will inherit from `comint-mode-map' when entering | 234 | ;; This map will inherit from `comint-mode-map' when entering |
| 226 | ;; inferior-prolog-mode. | 235 | ;; inferior-prolog-mode. |
| 236 | (define-key map [remap self-insert-command] | ||
| 237 | 'inferior-prolog-self-insert-command) | ||
| 227 | map)) | 238 | map)) |
| 228 | 239 | ||
| 229 | (defvar inferior-prolog-mode-syntax-table prolog-mode-syntax-table) | 240 | (defvar inferior-prolog-mode-syntax-table prolog-mode-syntax-table) |
| @@ -256,36 +267,129 @@ Return not at end copies rest of line to end and sends it. | |||
| 256 | (setq comint-prompt-regexp "^| [ ?][- ] *") | 267 | (setq comint-prompt-regexp "^| [ ?][- ] *") |
| 257 | (prolog-mode-variables)) | 268 | (prolog-mode-variables)) |
| 258 | 269 | ||
| 270 | (defvar inferior-prolog-buffer nil) | ||
| 271 | |||
| 272 | (defun inferior-prolog-run (&optional name) | ||
| 273 | (with-current-buffer (make-comint "prolog" (or name prolog-program-name)) | ||
| 274 | (inferior-prolog-mode) | ||
| 275 | (setq-default inferior-prolog-buffer (current-buffer)) | ||
| 276 | (make-local-variable 'inferior-prolog-buffer) | ||
| 277 | (when (and name (not (equal name prolog-program-name))) | ||
| 278 | (set (make-local-variable 'prolog-program-name) name)) | ||
| 279 | (set (make-local-variable 'inferior-prolog-flavor) | ||
| 280 | ;; Force re-detection. | ||
| 281 | (let* ((proc (get-buffer-process (current-buffer))) | ||
| 282 | (pmark (and proc (marker-position (process-mark proc))))) | ||
| 283 | (cond | ||
| 284 | ((null pmark) (1- (point-min))) | ||
| 285 | ;; The use of insert-before-markers in comint.el together with | ||
| 286 | ;; the potential use of comint-truncate-buffer in the output | ||
| 287 | ;; filter, means that it's difficult to reliably keep track of | ||
| 288 | ;; the buffer position where the process's output started. | ||
| 289 | ;; If possible we use a marker at "start - 1", so that | ||
| 290 | ;; insert-before-marker at `start' won't shift it. And if not, | ||
| 291 | ;; we fall back on using a plain integer. | ||
| 292 | ((> pmark (point-min)) (copy-marker (1- pmark))) | ||
| 293 | (t (1- pmark))))) | ||
| 294 | (add-hook 'comint-output-filter-functions | ||
| 295 | 'inferior-prolog-guess-flavor nil t))) | ||
| 296 | |||
| 297 | (defun inferior-prolog-process (&optional dontstart) | ||
| 298 | (or (and (buffer-live-p inferior-prolog-buffer) | ||
| 299 | (get-buffer-process inferior-prolog-buffer)) | ||
| 300 | (unless dontstart | ||
| 301 | (inferior-prolog-run) | ||
| 302 | ;; Try again. | ||
| 303 | (inferior-prolog-process)))) | ||
| 304 | |||
| 305 | (defvar inferior-prolog-flavor 'unknown | ||
| 306 | "Either a symbol or a buffer position offset by one. | ||
| 307 | If a buffer position, the flavor has not been determined yet and | ||
| 308 | it is expected that the process's output has been or will | ||
| 309 | be inserted at that position plus one.") | ||
| 310 | |||
| 311 | (defun inferior-prolog-guess-flavor (&optional ignored) | ||
| 312 | (save-excursion | ||
| 313 | (goto-char (1+ inferior-prolog-flavor)) | ||
| 314 | (setq inferior-prolog-flavor | ||
| 315 | (cond | ||
| 316 | ((looking-at "GNU Prolog") 'gnu) | ||
| 317 | ((looking-at "Welcome to SWI-Prolog") 'swi) | ||
| 318 | ((looking-at ".*\n") 'unknown) ;There's at least one line. | ||
| 319 | (t inferior-prolog-flavor)))) | ||
| 320 | (when (symbolp inferior-prolog-flavor) | ||
| 321 | (remove-hook 'comint-output-filter-functions | ||
| 322 | 'inferior-prolog-guess-flavor t) | ||
| 323 | (if (eq inferior-prolog-flavor 'gnu) | ||
| 324 | (set (make-local-variable 'comint-process-echoes) t)))) | ||
| 325 | |||
| 259 | ;;;###autoload | 326 | ;;;###autoload |
| 260 | (defun run-prolog () | 327 | (defalias 'run-prolog 'switch-to-prolog) |
| 261 | "Run an inferior Prolog process, input and output via buffer *prolog*." | 328 | ;;;###autoload |
| 329 | (defun switch-to-prolog (&optional name) | ||
| 330 | "Run an inferior Prolog process, input and output via buffer *prolog*. | ||
| 331 | With prefix argument \\[universal-prefix], prompt for the program to use." | ||
| 332 | (interactive | ||
| 333 | (list (when current-prefix-arg | ||
| 334 | (let ((proc (inferior-prolog-process 'dontstart))) | ||
| 335 | (if proc | ||
| 336 | (if (yes-or-no-p "Kill current process before starting new one? ") | ||
| 337 | (kill-process proc) | ||
| 338 | (error "Abort"))) | ||
| 339 | (read-string "Run Prolog: " prolog-program-name))))) | ||
| 340 | (unless (inferior-prolog-process 'dontstart) | ||
| 341 | (inferior-prolog-run name)) | ||
| 342 | (pop-to-buffer inferior-prolog-buffer)) | ||
| 343 | |||
| 344 | (defun inferior-prolog-self-insert-command () | ||
| 345 | "Insert the char in the buffer or pass it directly to the process." | ||
| 262 | (interactive) | 346 | (interactive) |
| 263 | (require 'comint) | 347 | (let* ((proc (get-buffer-process (current-buffer))) |
| 264 | (pop-to-buffer (make-comint "prolog" prolog-program-name)) | 348 | (pmark (and proc (marker-position (process-mark proc))))) |
| 265 | (inferior-prolog-mode)) | 349 | (if (and (eq inferior-prolog-flavor 'gnu) |
| 350 | pmark | ||
| 351 | (null current-prefix-arg) | ||
| 352 | (eobp) | ||
| 353 | (eq (point) pmark) | ||
| 354 | (save-excursion | ||
| 355 | (goto-char (- pmark 3)) | ||
| 356 | (looking-at " \\? "))) | ||
| 357 | (comint-send-string proc (string last-command-char)) | ||
| 358 | (call-interactively 'self-insert-command)))) | ||
| 266 | 359 | ||
| 267 | (defun prolog-consult-region (compile beg end) | 360 | (defun prolog-consult-region (compile beg end) |
| 268 | "Send the region to the Prolog process made by \"M-x run-prolog\". | 361 | "Send the region to the Prolog process made by \"M-x run-prolog\". |
| 269 | If COMPILE (prefix arg) is not nil, use compile mode rather than consult mode." | 362 | If COMPILE (prefix arg) is not nil, use compile mode rather than consult mode." |
| 270 | (interactive "P\nr") | 363 | (interactive "P\nr") |
| 271 | (save-excursion | 364 | (let ((proc (inferior-prolog-process))) |
| 272 | (if compile | 365 | (comint-send-string proc |
| 273 | (process-send-string "prolog" prolog-compile-string) | 366 | (if compile prolog-compile-string |
| 274 | (process-send-string "prolog" prolog-consult-string)) | 367 | prolog-consult-string)) |
| 275 | (process-send-region "prolog" beg end) | 368 | (comint-send-region proc beg end) |
| 276 | (process-send-string "prolog" "\n") ;May be unnecessary | 369 | (comint-send-string proc "\n") ;May be unnecessary |
| 277 | (if prolog-eof-string | 370 | (if prolog-eof-string |
| 278 | (process-send-string "prolog" prolog-eof-string) | 371 | (comint-send-string proc prolog-eof-string) |
| 279 | (process-send-eof "prolog")))) ;Send eof to prolog process. | 372 | (with-current-buffer (process-buffer proc) |
| 373 | (comint-send-eof))))) ;Send eof to prolog process. | ||
| 280 | 374 | ||
| 281 | (defun prolog-consult-region-and-go (compile beg end) | 375 | (defun prolog-consult-region-and-go (compile beg end) |
| 282 | "Send the region to the inferior Prolog, and switch to *prolog* buffer. | 376 | "Send the region to the inferior Prolog, and switch to *prolog* buffer. |
| 283 | If COMPILE (prefix arg) is not nil, use compile mode rather than consult mode." | 377 | If COMPILE (prefix arg) is not nil, use compile mode rather than consult mode." |
| 284 | (interactive "P\nr") | 378 | (interactive "P\nr") |
| 285 | (prolog-consult-region compile beg end) | 379 | (prolog-consult-region compile beg end) |
| 286 | (switch-to-buffer "*prolog*")) | 380 | (pop-to-buffer inferior-prolog-buffer)) |
| 381 | |||
| 382 | (defun inferior-prolog-load-file () | ||
| 383 | "Pass the current buffer's file to the inferior prolog process." | ||
| 384 | (interactive) | ||
| 385 | (save-buffer) | ||
| 386 | (let ((file buffer-file-name) | ||
| 387 | (proc (inferior-prolog-process))) | ||
| 388 | (with-current-buffer (process-buffer proc) | ||
| 389 | (comint-send-string proc (concat "['" (file-relative-name file) "'].\n")) | ||
| 390 | (pop-to-buffer (current-buffer))))) | ||
| 287 | 391 | ||
| 288 | (provide 'prolog) | 392 | (provide 'prolog) |
| 289 | 393 | ||
| 290 | ;;; arch-tag: f3ec6748-1272-4ab6-8826-c50cb1607636 | 394 | ;; arch-tag: f3ec6748-1272-4ab6-8826-c50cb1607636 |
| 291 | ;;; prolog.el ends here | 395 | ;;; prolog.el ends here |
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index c38a6e82f83..0387c05134e 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el | |||
| @@ -67,7 +67,8 @@ | |||
| 67 | (eval-when-compile | 67 | (eval-when-compile |
| 68 | (require 'cl) | 68 | (require 'cl) |
| 69 | (require 'compile) | 69 | (require 'compile) |
| 70 | (require 'comint)) | 70 | (require 'comint) |
| 71 | (require 'hippie-exp)) | ||
| 71 | 72 | ||
| 72 | (autoload 'comint-mode "comint") | 73 | (autoload 'comint-mode "comint") |
| 73 | 74 | ||
| @@ -95,7 +96,9 @@ | |||
| 95 | "import" "in" "is" "lambda" "not" "or" "pass" "print" | 96 | "import" "in" "is" "lambda" "not" "or" "pass" "print" |
| 96 | "raise" "return" "try" "while" "yield" | 97 | "raise" "return" "try" "while" "yield" |
| 97 | ;; Future keywords | 98 | ;; Future keywords |
| 98 | "as" "None") | 99 | "as" "None" |
| 100 | ;; Not real keywords, but close enough to be fontified as such | ||
| 101 | "self" "True" "False") | ||
| 99 | symbol-end) | 102 | symbol-end) |
| 100 | ;; Definitions | 103 | ;; Definitions |
| 101 | (,(rx symbol-start (group "class") (1+ space) (group (1+ (or word ?_)))) | 104 | (,(rx symbol-start (group "class") (1+ space) (group (1+ (or word ?_)))) |
| @@ -1286,7 +1289,7 @@ Don't save anything for STR matching `inferior-python-filter-regexp'." | |||
| 1286 | ;; Maybe we could be more selective here. | 1289 | ;; Maybe we could be more selective here. |
| 1287 | (if (zerop (length res)) | 1290 | (if (zerop (length res)) |
| 1288 | (not (bolp)) | 1291 | (not (bolp)) |
| 1289 | (string-match res ".\\'")))) | 1292 | (string-match ".\\'" res)))) |
| 1290 | ;; The need for this seems to be system-dependent: | 1293 | ;; The need for this seems to be system-dependent: |
| 1291 | ;; What is this all about, exactly? --Stef | 1294 | ;; What is this all about, exactly? --Stef |
| 1292 | ;; (if (and (eq ?. (aref s 0))) | 1295 | ;; (if (and (eq ?. (aref s 0))) |
| @@ -1330,30 +1333,30 @@ buffer for a list of commands.)" | |||
| 1330 | ;; (not a name) in Python buffers from which `run-python' &c is | 1333 | ;; (not a name) in Python buffers from which `run-python' &c is |
| 1331 | ;; invoked. Would support multiple processes better. | 1334 | ;; invoked. Would support multiple processes better. |
| 1332 | (when (or new (not (comint-check-proc python-buffer))) | 1335 | (when (or new (not (comint-check-proc python-buffer))) |
| 1333 | (save-current-buffer | 1336 | (with-current-buffer |
| 1334 | (let* ((cmdlist (append (python-args-to-list cmd) '("-i"))) | 1337 | (let* ((cmdlist (append (python-args-to-list cmd) '("-i"))) |
| 1335 | (path (getenv "PYTHONPATH")) | 1338 | (path (getenv "PYTHONPATH")) |
| 1336 | (process-environment ; to import emacs.py | 1339 | (process-environment ; to import emacs.py |
| 1337 | (cons (concat "PYTHONPATH=" data-directory | 1340 | (cons (concat "PYTHONPATH=" data-directory |
| 1338 | (if path (concat ":" path))) | 1341 | (if path (concat ":" path))) |
| 1339 | process-environment))) | 1342 | process-environment))) |
| 1340 | (set-buffer (apply 'make-comint-in-buffer "Python" | 1343 | (apply 'make-comint-in-buffer "Python" |
| 1341 | (generate-new-buffer "*Python*") | 1344 | (if new (generate-new-buffer "*Python*") "*Python*") |
| 1342 | (car cmdlist) nil (cdr cmdlist))) | 1345 | (car cmdlist) nil (cdr cmdlist))) |
| 1343 | (setq-default python-buffer (current-buffer)) | 1346 | (setq-default python-buffer (current-buffer)) |
| 1344 | (setq python-buffer (current-buffer))) | 1347 | (setq python-buffer (current-buffer)) |
| 1345 | (accept-process-output (get-buffer-process python-buffer) 5) | 1348 | (accept-process-output (get-buffer-process python-buffer) 5) |
| 1346 | (inferior-python-mode))) | 1349 | (inferior-python-mode) |
| 1350 | ;; Load function definitions we need. | ||
| 1351 | ;; Before the preoutput function was used, this was done via -c in | ||
| 1352 | ;; cmdlist, but that loses the banner and doesn't run the startup | ||
| 1353 | ;; file. The code might be inline here, but there's enough that it | ||
| 1354 | ;; seems worth putting in a separate file, and it's probably cleaner | ||
| 1355 | ;; to put it in a module. | ||
| 1356 | ;; Ensure we're at a prompt before doing anything else. | ||
| 1357 | (python-send-receive "import emacs; print '_emacs_out ()'"))) | ||
| 1347 | (if (derived-mode-p 'python-mode) | 1358 | (if (derived-mode-p 'python-mode) |
| 1348 | (setq python-buffer (default-value 'python-buffer))) ; buffer-local | 1359 | (setq python-buffer (default-value 'python-buffer))) ; buffer-local |
| 1349 | ;; Load function definitions we need. | ||
| 1350 | ;; Before the preoutput function was used, this was done via -c in | ||
| 1351 | ;; cmdlist, but that loses the banner and doesn't run the startup | ||
| 1352 | ;; file. The code might be inline here, but there's enough that it | ||
| 1353 | ;; seems worth putting in a separate file, and it's probably cleaner | ||
| 1354 | ;; to put it in a module. | ||
| 1355 | ;; Ensure we're at a prompt before doing anything else. | ||
| 1356 | (python-send-receive "import emacs; print '_emacs_out ()'") | ||
| 1357 | ;; Without this, help output goes into the inferior python buffer if | 1360 | ;; Without this, help output goes into the inferior python buffer if |
| 1358 | ;; the process isn't already running. | 1361 | ;; the process isn't already running. |
| 1359 | (sit-for 1 t) ;Should we use accept-process-output instead? --Stef | 1362 | (sit-for 1 t) ;Should we use accept-process-output instead? --Stef |
| @@ -1369,15 +1372,20 @@ buffer for a list of commands.)" | |||
| 1369 | (defun python-send-command (command) | 1372 | (defun python-send-command (command) |
| 1370 | "Like `python-send-string' but resets `compilation-shell-minor-mode'. | 1373 | "Like `python-send-string' but resets `compilation-shell-minor-mode'. |
| 1371 | COMMAND should be a single statement." | 1374 | COMMAND should be a single statement." |
| 1372 | (assert (not (string-match "\n" command))) | 1375 | ;; (assert (not (string-match "\n" command))) |
| 1373 | (let ((end (marker-position (process-mark (python-proc))))) | 1376 | ;; (let ((end (marker-position (process-mark (python-proc))))) |
| 1374 | (with-current-buffer python-buffer (goto-char (point-max))) | 1377 | (with-current-buffer python-buffer (goto-char (point-max))) |
| 1375 | (compilation-forget-errors) | 1378 | (compilation-forget-errors) |
| 1376 | ;; Must wait until this has completed before re-setting variables below. | 1379 | (python-send-string command) |
| 1377 | (python-send-receive (concat command "; print '_emacs_out ()'")) | ||
| 1378 | (with-current-buffer python-buffer | 1380 | (with-current-buffer python-buffer |
| 1379 | (set-marker compilation-parsing-end end) | 1381 | (setq compilation-last-buffer (current-buffer))) |
| 1380 | (setq compilation-last-buffer (current-buffer))))) | 1382 | ;; No idea what this is for but it breaks the call to |
| 1383 | ;; compilation-fake-loc in python-send-region. -- Stef | ||
| 1384 | ;; Must wait until this has completed before re-setting variables below. | ||
| 1385 | ;; (python-send-receive "print '_emacs_out ()'") | ||
| 1386 | ;; (with-current-buffer python-buffer | ||
| 1387 | ;; (set-marker compilation-parsing-end end)) | ||
| 1388 | ) ;;) | ||
| 1381 | 1389 | ||
| 1382 | (defun python-send-region (start end) | 1390 | (defun python-send-region (start end) |
| 1383 | "Send the region to the inferior Python process." | 1391 | "Send the region to the inferior Python process." |
| @@ -1419,11 +1427,13 @@ COMMAND should be a single statement." | |||
| 1419 | "Evaluate STRING in inferior Python process." | 1427 | "Evaluate STRING in inferior Python process." |
| 1420 | (interactive "sPython command: ") | 1428 | (interactive "sPython command: ") |
| 1421 | (comint-send-string (python-proc) string) | 1429 | (comint-send-string (python-proc) string) |
| 1422 | (comint-send-string (python-proc) | 1430 | (unless (string-match "\n\\'" string) |
| 1423 | ;; If the string is single-line or if it ends with \n, | 1431 | ;; Make sure the text is properly LF-terminated. |
| 1424 | ;; only add a single \n, otherwise add 2, so as to | 1432 | (comint-send-string (python-proc) "\n")) |
| 1425 | ;; make sure we terminate the multiline instruction. | 1433 | (when (string-match "\n[ \t].*\n?\\'" string) |
| 1426 | (if (string-match "\n.+\\'" string) "\n\n" "\n"))) | 1434 | ;; If the string contains a final indented line, add a second newline so |
| 1435 | ;; as to make sure we terminate the multiline instruction. | ||
| 1436 | (comint-send-string (python-proc) "\n"))) | ||
| 1427 | 1437 | ||
| 1428 | (defun python-send-buffer () | 1438 | (defun python-send-buffer () |
| 1429 | "Send the current buffer to the inferior Python process." | 1439 | "Send the current buffer to the inferior Python process." |
| @@ -1594,24 +1604,26 @@ Only works when point is in a function name, not its arg list, for | |||
| 1594 | instance. Assumes an inferior Python is running." | 1604 | instance. Assumes an inferior Python is running." |
| 1595 | (let ((symbol (with-syntax-table python-dotty-syntax-table | 1605 | (let ((symbol (with-syntax-table python-dotty-syntax-table |
| 1596 | (current-word)))) | 1606 | (current-word)))) |
| 1597 | ;; First try the symbol we're on. | 1607 | ;; This is run from timers, so inhibit-quit tends to be set. |
| 1598 | (or (and symbol | 1608 | (with-local-quit |
| 1599 | (python-send-receive (format "emacs.eargs(%S, %s)" | 1609 | ;; First try the symbol we're on. |
| 1600 | symbol python-imports))) | 1610 | (or (and symbol |
| 1601 | ;; Try moving to symbol before enclosing parens. | 1611 | (python-send-receive (format "emacs.eargs(%S, %s)" |
| 1602 | (let ((s (syntax-ppss))) | 1612 | symbol python-imports))) |
| 1603 | (unless (zerop (car s)) | 1613 | ;; Try moving to symbol before enclosing parens. |
| 1604 | (when (eq ?\( (char-after (nth 1 s))) | 1614 | (let ((s (syntax-ppss))) |
| 1605 | (save-excursion | 1615 | (unless (zerop (car s)) |
| 1606 | (goto-char (nth 1 s)) | 1616 | (when (eq ?\( (char-after (nth 1 s))) |
| 1607 | (skip-syntax-backward "-") | 1617 | (save-excursion |
| 1608 | (let ((point (point))) | 1618 | (goto-char (nth 1 s)) |
| 1609 | (skip-chars-backward "a-zA-Z._") | 1619 | (skip-syntax-backward "-") |
| 1610 | (if (< (point) point) | 1620 | (let ((point (point))) |
| 1611 | (python-send-receive | 1621 | (skip-chars-backward "a-zA-Z._") |
| 1612 | (format "emacs.eargs(%S, %s)" | 1622 | (if (< (point) point) |
| 1613 | (buffer-substring-no-properties (point) point) | 1623 | (python-send-receive |
| 1614 | python-imports))))))))))) | 1624 | (format "emacs.eargs(%S, %s)" |
| 1625 | (buffer-substring-no-properties (point) point) | ||
| 1626 | python-imports)))))))))))) | ||
| 1615 | 1627 | ||
| 1616 | ;;;; Info-look functionality. | 1628 | ;;;; Info-look functionality. |
| 1617 | 1629 | ||
diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index f828c36917b..83b4bdea759 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el | |||
| @@ -2460,46 +2460,45 @@ we go to the end of the previous line and do not check for continuations." | |||
| 2460 | ;; | 2460 | ;; |
| 2461 | (if (bolp) | 2461 | (if (bolp) |
| 2462 | nil | 2462 | nil |
| 2463 | (let (c min-point | 2463 | (let ((start (point)) |
| 2464 | (start (point))) | 2464 | (min-point (if (sh-this-is-a-continuation) |
| 2465 | (save-restriction | 2465 | (sh-prev-line nil) |
| 2466 | (narrow-to-region | 2466 | (line-beginning-position)))) |
| 2467 | (if (sh-this-is-a-continuation) | 2467 | (skip-chars-backward " \t;" min-point) |
| 2468 | (setq min-point (sh-prev-line nil)) | 2468 | (if (looking-at "\\s-*;;") |
| 2469 | (save-excursion | 2469 | ;; (message "Found ;; !") |
| 2470 | (beginning-of-line) | 2470 | ";;" |
| 2471 | (setq min-point (point)))) | 2471 | (skip-chars-backward "^)}];\"'`({[" min-point) |
| 2472 | (point)) | 2472 | (let ((c (if (> (point) min-point) (char-before)))) |
| 2473 | (skip-chars-backward " \t;") | 2473 | (sh-debug "stopping at %d c is %s start=%d min-point=%d" |
| 2474 | (unless (looking-at "\\s-*;;") | 2474 | (point) c start min-point) |
| 2475 | (skip-chars-backward "^)}];\"'`({[") | 2475 | (if (not (memq c '(?\n nil ?\;))) |
| 2476 | (setq c (char-before)))) | 2476 | ;; c -- return a string |
| 2477 | (sh-debug "stopping at %d c is %s start=%d min-point=%d" | 2477 | (char-to-string c) |
| 2478 | (point) c start min-point) | 2478 | ;; Return the leading keyword of the "command" we supposedly |
| 2479 | (if (< (point) min-point) | 2479 | ;; skipped over. Maybe we skipped too far (e.g. past a `do' or |
| 2480 | (error "point %d < min-point %d" (point) min-point)) | 2480 | ;; `then' that precedes the actual command), so check whether |
| 2481 | (cond | 2481 | ;; we're looking at such a keyword and if so, move back forward. |
| 2482 | ((looking-at "\\s-*;;") | 2482 | (let ((boundary (point)) |
| 2483 | ;; (message "Found ;; !") | 2483 | kwd next) |
| 2484 | ";;") | 2484 | (while |
| 2485 | ((or (eq c ?\n) | 2485 | (progn |
| 2486 | (eq c nil) | 2486 | ;; Skip forward over white space newline and \ at eol. |
| 2487 | (eq c ?\;)) | 2487 | (skip-chars-forward " \t\n\\\\" start) |
| 2488 | (save-excursion | 2488 | (if (>= (point) start) |
| 2489 | ;; skip forward over white space newline and \ at eol | 2489 | (progn |
| 2490 | (skip-chars-forward " \t\n\\\\") | 2490 | (sh-debug "point: %d >= start: %d" (point) start) |
| 2491 | (sh-debug "Now at %d start=%d" (point) start) | 2491 | nil) |
| 2492 | (if (>= (point) start) | 2492 | (if next (setq boundary next)) |
| 2493 | (progn | 2493 | (sh-debug "Now at %d start=%d" (point) start) |
| 2494 | (sh-debug "point: %d >= start: %d" (point) start) | 2494 | (setq kwd (sh-get-word)) |
| 2495 | nil) | 2495 | (if (member kwd (sh-feature sh-leading-keywords)) |
| 2496 | (sh-get-word)) | 2496 | (progn |
| 2497 | )) | 2497 | (setq next (point)) |
| 2498 | (t | 2498 | t) |
| 2499 | ;; c -- return a string | 2499 | nil)))) |
| 2500 | (char-to-string c) | 2500 | (goto-char boundary) |
| 2501 | )) | 2501 | kwd))))))) |
| 2502 | ))) | ||
| 2503 | 2502 | ||
| 2504 | 2503 | ||
| 2505 | (defun sh-this-is-a-continuation () | 2504 | (defun sh-this-is-a-continuation () |
| @@ -2518,7 +2517,7 @@ If AND-MOVE is non-nil then move to end of word." | |||
| 2518 | (goto-char where)) | 2517 | (goto-char where)) |
| 2519 | (prog1 | 2518 | (prog1 |
| 2520 | (buffer-substring (point) | 2519 | (buffer-substring (point) |
| 2521 | (progn (skip-chars-forward "^ \t\n;&")(point))) | 2520 | (progn (skip-chars-forward "^ \t\n;&|()")(point))) |
| 2522 | (unless and-move | 2521 | (unless and-move |
| 2523 | (goto-char start))))) | 2522 | (goto-char start))))) |
| 2524 | 2523 | ||