diff options
| author | Stefan Monnier | 2003-02-23 01:42:24 +0000 |
|---|---|---|
| committer | Stefan Monnier | 2003-02-23 01:42:24 +0000 |
| commit | 83261a2f134a3fbb8c5d4977b8e96e9fb136b744 (patch) | |
| tree | 4345e60d3438c86fac0fdc3c3d482d0b6c9cdaf3 /lisp | |
| parent | 7114be0e0ac73b752ab70a7159cdab2a32bf6f4c (diff) | |
| download | emacs-83261a2f134a3fbb8c5d4977b8e96e9fb136b744.tar.gz emacs-83261a2f134a3fbb8c5d4977b8e96e9fb136b744.zip | |
Merge changes from CPerl-4.35.
(cperl-xemacs-p): Move.
(cperl-can-font-lock): New var to replace window-system.
(cperl-enable-font-lock): Use it.
(cperl-use-major-mode): New var.
(cperl-mode): Use it.
(cperl-calculate-indent): Remove code whose removal was missed
in some earlier merge.
(cperl-tags-hier-init): Use display-popup-menus-p.
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/progmodes/cperl-mode.el | 2266 |
1 files changed, 1127 insertions, 1139 deletions
diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index a593d94ab98..4084f824eaa 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el | |||
| @@ -1,10 +1,10 @@ | |||
| 1 | ;;; cperl-mode.el --- Perl code editing commands for Emacs | 1 | ;;; cperl-mode.el --- Perl code editing commands for Emacs |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1985, 86, 87, 91, 92, 93, 94, 95, 96, 1997 | 3 | ;; Copyright (C) 1985, 86, 87, 91, 92, 93, 94, 95, 96, 97, 98, 99, 2000, 2003 |
| 4 | ;; Free Software Foundation, Inc. | 4 | ;; Free Software Foundation, Inc. |
| 5 | 5 | ||
| 6 | ;; Author: Ilya Zakharevich and Bob Olson | 6 | ;; Author: Ilya Zakharevich and Bob Olson |
| 7 | ;; Maintainer: Ilya Zakharevich <ilya@math.ohio-state.edu> | 7 | ;; Maintainer: Ilya Zakharevich <cperl@ilyaz.org> |
| 8 | ;; Keywords: languages, Perl | 8 | ;; Keywords: languages, Perl |
| 9 | 9 | ||
| 10 | ;; This file is part of GNU Emacs. | 10 | ;; This file is part of GNU Emacs. |
| @@ -24,52 +24,63 @@ | |||
| 24 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | 24 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
| 25 | ;; Boston, MA 02111-1307, USA. | 25 | ;; Boston, MA 02111-1307, USA. |
| 26 | 26 | ||
| 27 | ;;; Corrections made by Ilya Zakharevich ilya@math.mps.ohio-state.edu | 27 | ;;; Corrections made by Ilya Zakharevich cperl@ilyaz.org |
| 28 | 28 | ||
| 29 | ;;; Commentary: | 29 | ;;; Commentary: |
| 30 | 30 | ||
| 31 | ;;; You can either fine-tune the bells and whistles of this mode or | 31 | ;; You can either fine-tune the bells and whistles of this mode or |
| 32 | ;;; bulk enable them by putting | 32 | ;; bulk enable them by putting |
| 33 | 33 | ||
| 34 | ;; (setq cperl-hairy t) | 34 | ;; (setq cperl-hairy t) |
| 35 | 35 | ||
| 36 | ;;; in your .emacs file. (Emacs rulers do not consider it politically | 36 | ;; in your .emacs file. (Emacs rulers do not consider it politically |
| 37 | ;;; correct to make whistles enabled by default.) | 37 | ;; correct to make whistles enabled by default.) |
| 38 | 38 | ||
| 39 | ;;; DO NOT FORGET to read micro-docs (available from `Perl' menu) <<<<<< | 39 | ;; DO NOT FORGET to read micro-docs (available from `Perl' menu) <<<<<< |
| 40 | ;;; or as help on variables `cperl-tips', `cperl-problems', <<<<<< | 40 | ;; or as help on variables `cperl-tips', `cperl-problems', <<<<<< |
| 41 | ;;; `cperl-praise', `cperl-speed'. <<<<<< | 41 | ;; `cperl-praise', `cperl-speed'. <<<<<< |
| 42 | 42 | ||
| 43 | ;;; The mode information (on C-h m) provides some customization help. | 43 | ;; The mode information (on C-h m) provides some customization help. |
| 44 | ;;; If you use font-lock feature of this mode, it is advisable to use | 44 | ;; If you use font-lock feature of this mode, it is advisable to use |
| 45 | ;;; either lazy-lock-mode or fast-lock-mode. I prefer lazy-lock. | 45 | ;; either lazy-lock-mode or fast-lock-mode. I prefer lazy-lock. |
| 46 | 46 | ||
| 47 | ;;; Faces used now: three faces for first-class and second-class keywords | 47 | ;; Faces used now: three faces for first-class and second-class keywords |
| 48 | ;;; and control flow words, one for each: comments, string, labels, | 48 | ;; and control flow words, one for each: comments, string, labels, |
| 49 | ;;; functions definitions and packages, arrays, hashes, and variable | 49 | ;; functions definitions and packages, arrays, hashes, and variable |
| 50 | ;;; definitions. If you do not see all these faces, your font-lock does | 50 | ;; definitions. If you do not see all these faces, your font-lock does |
| 51 | ;;; not define them, so you need to define them manually. | 51 | ;; not define them, so you need to define them manually. |
| 52 | 52 | ||
| 53 | ;;; into your .emacs file. | 53 | ;; This mode supports font-lock, imenu and mode-compile. In the |
| 54 | 54 | ;; hairy version font-lock is on, but you should activate imenu | |
| 55 | ;;;; This mode supports font-lock, imenu and mode-compile. In the | 55 | ;; yourself (note that mode-compile is not standard yet). Well, you |
| 56 | ;;;; hairy version font-lock is on, but you should activate imenu | 56 | ;; can use imenu from keyboard anyway (M-x imenu), but it is better |
| 57 | ;;;; yourself (note that mode-compile is not standard yet). Well, you | 57 | ;; to bind it like that: |
| 58 | ;;;; can use imenu from keyboard anyway (M-x imenu), but it is better | ||
| 59 | ;;;; to bind it like that: | ||
| 60 | 58 | ||
| 61 | ;; (define-key global-map [M-S-down-mouse-3] 'imenu) | 59 | ;; (define-key global-map [M-S-down-mouse-3] 'imenu) |
| 62 | 60 | ||
| 61 | ;;; Font lock bugs as of v4.32: | ||
| 62 | |||
| 63 | ;; The following kinds of Perl code erroneously start strings: | ||
| 64 | ;; \$` \$' \$" | ||
| 65 | ;; $opt::s $opt_s $opt{s} (s => ...) /\s+.../ | ||
| 66 | ;; likewise with m, tr, y, q, qX instead of s | ||
| 67 | |||
| 63 | ;;; Code: | 68 | ;;; Code: |
| 64 | 69 | ||
| 65 | ;; Some macros are needed for `defcustom' | 70 | ;; Some macros are needed for `defcustom' |
| 66 | (eval-when-compile | 71 | (eval-when-compile |
| 67 | (require 'font-lock) | 72 | (defconst cperl-xemacs-p (string-match "XEmacs\\|Lucid" emacs-version)) |
| 73 | (defvar cperl-can-font-lock | ||
| 74 | (or cperl-xemacs-p | ||
| 75 | (and (boundp 'emacs-major-version) | ||
| 76 | (or window-system | ||
| 77 | (> emacs-major-version 20))))) | ||
| 78 | (if cperl-can-font-lock | ||
| 79 | (require 'font-lock)) | ||
| 68 | (defvar msb-menu-cond) | 80 | (defvar msb-menu-cond) |
| 69 | (defvar gud-perldb-history) | 81 | (defvar gud-perldb-history) |
| 70 | (defvar font-lock-background-mode) ; not in Emacs | 82 | (defvar font-lock-background-mode) ; not in Emacs |
| 71 | (defvar font-lock-display-type) ; ditto | 83 | (defvar font-lock-display-type) ; ditto |
| 72 | (defconst cperl-xemacs-p (string-match "XEmacs\\|Lucid" emacs-version)) | ||
| 73 | (defmacro cperl-is-face (arg) ; Takes quoted arg | 84 | (defmacro cperl-is-face (arg) ; Takes quoted arg |
| 74 | (cond ((fboundp 'find-face) | 85 | (cond ((fboundp 'find-face) |
| 75 | `(find-face ,arg)) | 86 | `(find-face ,arg)) |
| @@ -112,6 +123,14 @@ | |||
| 112 | `(etags-goto-tag-location ,elt))) | 123 | `(etags-goto-tag-location ,elt))) |
| 113 | (autoload 'tmm-prompt "tmm")) | 124 | (autoload 'tmm-prompt "tmm")) |
| 114 | 125 | ||
| 126 | (defconst cperl-xemacs-p (string-match "XEmacs\\|Lucid" emacs-version)) | ||
| 127 | |||
| 128 | (defvar cperl-can-font-lock | ||
| 129 | (or cperl-xemacs-p | ||
| 130 | (and (boundp 'emacs-major-version) | ||
| 131 | (or window-system | ||
| 132 | (> emacs-major-version 20))))) | ||
| 133 | |||
| 115 | (defun cperl-choose-color (&rest list) | 134 | (defun cperl-choose-color (&rest list) |
| 116 | (let (answer) | 135 | (let (answer) |
| 117 | (while list | 136 | (while list |
| @@ -170,8 +189,7 @@ and do constructs look like: | |||
| 170 | instead of: | 189 | instead of: |
| 171 | 190 | ||
| 172 | if () { | 191 | if () { |
| 173 | } | 192 | }" |
| 174 | " | ||
| 175 | :type 'boolean | 193 | :type 'boolean |
| 176 | :group 'cperl-autoinsert-details) | 194 | :group 'cperl-autoinsert-details) |
| 177 | 195 | ||
| @@ -354,12 +372,12 @@ Can be overwritten by `cperl-hairy' to be 5 sec if nil." | |||
| 354 | :group 'cperl-affected-by-hairy) | 372 | :group 'cperl-affected-by-hairy) |
| 355 | 373 | ||
| 356 | (defcustom cperl-pod-face 'font-lock-comment-face | 374 | (defcustom cperl-pod-face 'font-lock-comment-face |
| 357 | "*Face for pod highlighting." | 375 | "*Face for POD highlighting." |
| 358 | :type 'face | 376 | :type 'face |
| 359 | :group 'cperl-faces) | 377 | :group 'cperl-faces) |
| 360 | 378 | ||
| 361 | (defcustom cperl-pod-head-face 'font-lock-variable-name-face | 379 | (defcustom cperl-pod-head-face 'font-lock-variable-name-face |
| 362 | "*Face for pod highlighting. | 380 | "*Face for POD highlighting. |
| 363 | Font for POD headers." | 381 | Font for POD headers." |
| 364 | :type 'face | 382 | :type 'face |
| 365 | :group 'cperl-faces) | 383 | :group 'cperl-faces) |
| @@ -376,7 +394,7 @@ Font for POD headers." | |||
| 376 | :group 'cperl-faces) | 394 | :group 'cperl-faces) |
| 377 | 395 | ||
| 378 | (defcustom cperl-pod-here-fontify '(featurep 'font-lock) | 396 | (defcustom cperl-pod-here-fontify '(featurep 'font-lock) |
| 379 | "*Not-nil after evaluation means to highlight pod and here-docs sections." | 397 | "*Not-nil after evaluation means to highlight POD and here-docs sections." |
| 380 | :type 'boolean | 398 | :type 'boolean |
| 381 | :group 'cperl-faces) | 399 | :group 'cperl-faces) |
| 382 | 400 | ||
| @@ -395,7 +413,7 @@ entered CPerl mode the first time will have no effect." | |||
| 395 | :group 'cperl) | 413 | :group 'cperl) |
| 396 | 414 | ||
| 397 | (defcustom cperl-pod-here-scan t | 415 | (defcustom cperl-pod-here-scan t |
| 398 | "*Not-nil means look for pod and here-docs sections during startup. | 416 | "*Not-nil means look for POD and here-docs sections during startup. |
| 399 | You can always make lookup from menu or using \\[cperl-find-pods-heres]." | 417 | You can always make lookup from menu or using \\[cperl-find-pods-heres]." |
| 400 | :type 'boolean | 418 | :type 'boolean |
| 401 | :group 'cperl-speed) | 419 | :group 'cperl-speed) |
| @@ -512,7 +530,7 @@ One should tune up `cperl-close-paren-offset' as well." | |||
| 512 | :group 'cperl-indentation-details) | 530 | :group 'cperl-indentation-details) |
| 513 | 531 | ||
| 514 | (defcustom cperl-syntaxify-by-font-lock | 532 | (defcustom cperl-syntaxify-by-font-lock |
| 515 | (and window-system | 533 | (and cperl-can-font-lock |
| 516 | (boundp 'parse-sexp-lookup-properties)) | 534 | (boundp 'parse-sexp-lookup-properties)) |
| 517 | "*Non-nil means that CPerl uses `font-lock's routines for syntaxification." | 535 | "*Non-nil means that CPerl uses `font-lock's routines for syntaxification." |
| 518 | :type '(choice (const message) boolean) | 536 | :type '(choice (const message) boolean) |
| @@ -593,7 +611,7 @@ when syntaxifying a chunk of buffer." | |||
| 593 | ;;; Short extra-docs. | 611 | ;;; Short extra-docs. |
| 594 | 612 | ||
| 595 | (defvar cperl-tips 'please-ignore-this-line | 613 | (defvar cperl-tips 'please-ignore-this-line |
| 596 | "Get newest version of this package from | 614 | "Get maybe newer version of this package from |
| 597 | ftp://ftp.math.ohio-state.edu/pub/users/ilya/emacs | 615 | ftp://ftp.math.ohio-state.edu/pub/users/ilya/emacs |
| 598 | and/or | 616 | and/or |
| 599 | ftp://ftp.math.ohio-state.edu/pub/users/ilya/perl | 617 | ftp://ftp.math.ohio-state.edu/pub/users/ilya/perl |
| @@ -602,9 +620,9 @@ patches to related files. | |||
| 602 | 620 | ||
| 603 | For best results apply to an older Emacs the patches from | 621 | For best results apply to an older Emacs the patches from |
| 604 | ftp://ftp.math.ohio-state.edu/pub/users/ilya/cperl-mode/patches | 622 | ftp://ftp.math.ohio-state.edu/pub/users/ilya/cperl-mode/patches |
| 605 | \(this upgrades syntax-parsing abilities of Emaxen v19.34 and | 623 | \(this upgrades syntax-parsing abilities of Emacsen v19.34 and |
| 606 | v20.2 up to the level of Emacs v20.3 - a must for a good Perl | 624 | v20.2 up to the level of Emacs v20.3 - a must for a good Perl |
| 607 | mode.) | 625 | mode.) As of beginning of 2003, XEmacs may provide a similar ability. |
| 608 | 626 | ||
| 609 | Get support packages choose-color.el (or font-lock-extra.el before | 627 | Get support packages choose-color.el (or font-lock-extra.el before |
| 610 | 19.30), imenu-go.el from the same place. \(Look for other files there | 628 | 19.30), imenu-go.el from the same place. \(Look for other files there |
| @@ -664,7 +682,8 @@ yet. | |||
| 664 | Emacs had a _very_ restricted syntax parsing engine until version | 682 | Emacs had a _very_ restricted syntax parsing engine until version |
| 665 | 20.1. Most problems below are corrected starting from this version of | 683 | 20.1. Most problems below are corrected starting from this version of |
| 666 | Emacs, and all of them should be fixed in version 20.3. (Or apply | 684 | Emacs, and all of them should be fixed in version 20.3. (Or apply |
| 667 | patches to Emacs 19.33/34 - see tips.) | 685 | patches to Emacs 19.33/34 - see tips.) XEmacs was very backward in |
| 686 | this respect (until 2003). | ||
| 668 | 687 | ||
| 669 | Note that even with newer Emacsen in some very rare cases the details | 688 | Note that even with newer Emacsen in some very rare cases the details |
| 670 | of interaction of `font-lock' and syntaxification may be not cleaned | 689 | of interaction of `font-lock' and syntaxification may be not cleaned |
| @@ -681,7 +700,7 @@ braces. | |||
| 681 | 700 | ||
| 682 | This may be confusing, since the regexp s#//#/#\; may be highlighted | 701 | This may be confusing, since the regexp s#//#/#\; may be highlighted |
| 683 | as a comment, but it will be recognized as a regexp by the indentation | 702 | as a comment, but it will be recognized as a regexp by the indentation |
| 684 | code. Or the opposite case, when a pod section is highlighted, but | 703 | code. Or the opposite case, when a POD section is highlighted, but |
| 685 | may break the indentation of the following code (though indentation | 704 | may break the indentation of the following code (though indentation |
| 686 | should work if the balance of delimiters is not broken by POD). | 705 | should work if the balance of delimiters is not broken by POD). |
| 687 | 706 | ||
| @@ -699,7 +718,7 @@ and on CPAN. | |||
| 699 | 718 | ||
| 700 | If these bugs cannot be fixed on your machine (say, you have an inferior | 719 | If these bugs cannot be fixed on your machine (say, you have an inferior |
| 701 | environment and cannot recompile), you may still disable all the fancy stuff | 720 | environment and cannot recompile), you may still disable all the fancy stuff |
| 702 | via `cperl-use-syntax-table-text-property'." ) | 721 | via `cperl-use-syntax-table-text-property'.") |
| 703 | 722 | ||
| 704 | (defvar cperl-praise 'please-ignore-this-line | 723 | (defvar cperl-praise 'please-ignore-this-line |
| 705 | "Advantages of CPerl mode. | 724 | "Advantages of CPerl mode. |
| @@ -783,8 +802,7 @@ the settings present before the switch. | |||
| 783 | line-breaks/spacing between elements of the construct. | 802 | line-breaks/spacing between elements of the construct. |
| 784 | 803 | ||
| 785 | 10) Uses a linear-time algorith for indentation of regions (on Emaxen with | 804 | 10) Uses a linear-time algorith for indentation of regions (on Emaxen with |
| 786 | capable syntax engines). | 805 | capable syntax engines).") |
| 787 | ") | ||
| 788 | 806 | ||
| 789 | (defvar cperl-speed 'please-ignore-this-line | 807 | (defvar cperl-speed 'please-ignore-this-line |
| 790 | "This is an incomplete compendium of what is available in other parts | 808 | "This is an incomplete compendium of what is available in other parts |
| @@ -828,8 +846,7 @@ B) Speed of editing operations. | |||
| 828 | wrongly matched parentheses, wrong indentation, etc. | 846 | wrongly matched parentheses, wrong indentation, etc. |
| 829 | 847 | ||
| 830 | One can unset `cperl-syntaxify-unwind'. This might speed up editing | 848 | One can unset `cperl-syntaxify-unwind'. This might speed up editing |
| 831 | of, say, long POD sections. | 849 | of, say, long POD sections.") |
| 832 | ") | ||
| 833 | 850 | ||
| 834 | (defvar cperl-tips-faces 'please-ignore-this-line | 851 | (defvar cperl-tips-faces 'please-ignore-this-line |
| 835 | "CPerl mode uses following faces for highlighting: | 852 | "CPerl mode uses following faces for highlighting: |
| @@ -870,8 +887,6 @@ the faces: please specify bold, italic, underline, shadow and box.) | |||
| 870 | 887 | ||
| 871 | ;;; Portability stuff: | 888 | ;;; Portability stuff: |
| 872 | 889 | ||
| 873 | (defconst cperl-xemacs-p (string-match "XEmacs\\|Lucid" emacs-version)) | ||
| 874 | |||
| 875 | (defmacro cperl-define-key (emacs-key definition &optional xemacs-key) | 890 | (defmacro cperl-define-key (emacs-key definition &optional xemacs-key) |
| 876 | `(define-key cperl-mode-map | 891 | `(define-key cperl-mode-map |
| 877 | ,(if xemacs-key | 892 | ,(if xemacs-key |
| @@ -899,9 +914,9 @@ the faces: please specify bold, italic, underline, shadow and box.) | |||
| 899 | (defun cperl-mark-active () mark-active)) | 914 | (defun cperl-mark-active () mark-active)) |
| 900 | 915 | ||
| 901 | (defsubst cperl-enable-font-lock () | 916 | (defsubst cperl-enable-font-lock () |
| 902 | (or cperl-xemacs-p window-system)) | 917 | cperl-can-font-lock) |
| 903 | 918 | ||
| 904 | (defun cperl-putback-char (c) ; Emacs 19 | 919 | (defun cperl-putback-char (c) ; Emacs 19 |
| 905 | (set 'unread-command-events (list c))) ; Avoid undefined warning | 920 | (set 'unread-command-events (list c))) ; Avoid undefined warning |
| 906 | 921 | ||
| 907 | (if (boundp 'unread-command-events) | 922 | (if (boundp 'unread-command-events) |
| @@ -955,24 +970,11 @@ the faces: please specify bold, italic, underline, shadow and box.) | |||
| 955 | ;;; (setq interpreter-mode-alist (append interpreter-mode-alist | 970 | ;;; (setq interpreter-mode-alist (append interpreter-mode-alist |
| 956 | ;;; '(("miniperl" . perl-mode)))))) | 971 | ;;; '(("miniperl" . perl-mode)))))) |
| 957 | (eval-when-compile | 972 | (eval-when-compile |
| 958 | (condition-case nil | 973 | (mapcar (lambda (p) |
| 959 | (require 'imenu) | 974 | (condition-case nil |
| 960 | (error nil)) | 975 | (require p) |
| 961 | (condition-case nil | 976 | (error nil))) |
| 962 | (require 'easymenu) | 977 | '(imenu easymenu etags timer man info)) |
| 963 | (error nil)) | ||
| 964 | (condition-case nil | ||
| 965 | (require 'etags) | ||
| 966 | (error nil)) | ||
| 967 | (condition-case nil | ||
| 968 | (require 'timer) | ||
| 969 | (error nil)) | ||
| 970 | (condition-case nil | ||
| 971 | (require 'man) | ||
| 972 | (error nil)) | ||
| 973 | (condition-case nil | ||
| 974 | (require 'info) | ||
| 975 | (error nil)) | ||
| 976 | (if (fboundp 'ps-extend-face-list) | 978 | (if (fboundp 'ps-extend-face-list) |
| 977 | (defmacro cperl-ps-extend-face-list (arg) | 979 | (defmacro cperl-ps-extend-face-list (arg) |
| 978 | `(ps-extend-face-list ,arg)) | 980 | `(ps-extend-face-list ,arg)) |
| @@ -1070,52 +1072,53 @@ the faces: please specify bold, italic, underline, shadow and box.) | |||
| 1070 | (condition-case nil | 1072 | (condition-case nil |
| 1071 | (progn | 1073 | (progn |
| 1072 | (require 'easymenu) | 1074 | (require 'easymenu) |
| 1073 | (easy-menu-define cperl-menu cperl-mode-map "Menu for CPerl mode" | 1075 | (easy-menu-define |
| 1074 | '("Perl" | 1076 | cperl-menu cperl-mode-map "Menu for CPerl mode" |
| 1075 | ["Beginning of function" beginning-of-defun t] | 1077 | '("Perl" |
| 1076 | ["End of function" end-of-defun t] | 1078 | ["Beginning of function" beginning-of-defun t] |
| 1077 | ["Mark function" mark-defun t] | 1079 | ["End of function" end-of-defun t] |
| 1078 | ["Indent expression" cperl-indent-exp t] | 1080 | ["Mark function" mark-defun t] |
| 1079 | ["Fill paragraph/comment" cperl-fill-paragraph t] | 1081 | ["Indent expression" cperl-indent-exp t] |
| 1080 | "----" | 1082 | ["Fill paragraph/comment" cperl-fill-paragraph t] |
| 1081 | ["Line up a construction" cperl-lineup (cperl-use-region-p)] | 1083 | "----" |
| 1082 | ["Invert if/unless/while etc" cperl-invert-if-unless t] | 1084 | ["Line up a construction" cperl-lineup (cperl-use-region-p)] |
| 1083 | ("Regexp" | 1085 | ["Invert if/unless/while etc" cperl-invert-if-unless t] |
| 1084 | ["Beautify" cperl-beautify-regexp | 1086 | ("Regexp" |
| 1085 | cperl-use-syntax-table-text-property] | 1087 | ["Beautify" cperl-beautify-regexp |
| 1086 | ["Beautify one level deep" (cperl-beautify-regexp 1) | 1088 | cperl-use-syntax-table-text-property] |
| 1087 | cperl-use-syntax-table-text-property] | 1089 | ["Beautify one level deep" (cperl-beautify-regexp 1) |
| 1088 | ["Beautify a group" cperl-beautify-level | 1090 | cperl-use-syntax-table-text-property] |
| 1089 | cperl-use-syntax-table-text-property] | 1091 | ["Beautify a group" cperl-beautify-level |
| 1090 | ["Beautify a group one level deep" (cperl-beautify-level 1) | 1092 | cperl-use-syntax-table-text-property] |
| 1091 | cperl-use-syntax-table-text-property] | 1093 | ["Beautify a group one level deep" (cperl-beautify-level 1) |
| 1092 | ["Contract a group" cperl-contract-level | 1094 | cperl-use-syntax-table-text-property] |
| 1093 | cperl-use-syntax-table-text-property] | 1095 | ["Contract a group" cperl-contract-level |
| 1094 | ["Contract groups" cperl-contract-levels | 1096 | cperl-use-syntax-table-text-property] |
| 1095 | cperl-use-syntax-table-text-property]) | 1097 | ["Contract groups" cperl-contract-levels |
| 1096 | ["Refresh \"hard\" constructions" cperl-find-pods-heres t] | 1098 | cperl-use-syntax-table-text-property]) |
| 1097 | "----" | 1099 | ["Refresh \"hard\" constructions" cperl-find-pods-heres t] |
| 1098 | ["Indent region" cperl-indent-region (cperl-use-region-p)] | 1100 | "----" |
| 1099 | ["Comment region" cperl-comment-region (cperl-use-region-p)] | 1101 | ["Indent region" cperl-indent-region (cperl-use-region-p)] |
| 1100 | ["Uncomment region" cperl-uncomment-region (cperl-use-region-p)] | 1102 | ["Comment region" cperl-comment-region (cperl-use-region-p)] |
| 1101 | "----" | 1103 | ["Uncomment region" cperl-uncomment-region (cperl-use-region-p)] |
| 1102 | ["Run" mode-compile (fboundp 'mode-compile)] | 1104 | "----" |
| 1103 | ["Kill" mode-compile-kill (and (fboundp 'mode-compile-kill) | 1105 | ["Run" mode-compile (fboundp 'mode-compile)] |
| 1104 | (get-buffer "*compilation*"))] | 1106 | ["Kill" mode-compile-kill (and (fboundp 'mode-compile-kill) |
| 1105 | ["Next error" next-error (get-buffer "*compilation*")] | 1107 | (get-buffer "*compilation*"))] |
| 1106 | ["Check syntax" cperl-check-syntax (fboundp 'mode-compile)] | 1108 | ["Next error" next-error (get-buffer "*compilation*")] |
| 1107 | "----" | 1109 | ["Check syntax" cperl-check-syntax (fboundp 'mode-compile)] |
| 1108 | ["Debugger" cperl-db t] | 1110 | "----" |
| 1109 | "----" | 1111 | ["Debugger" cperl-db t] |
| 1110 | ("Tools" | 1112 | "----" |
| 1111 | ["Imenu" imenu (fboundp 'imenu)] | 1113 | ("Tools" |
| 1112 | ["Insert spaces if needed" cperl-find-bad-style t] | 1114 | ["Imenu" imenu (fboundp 'imenu)] |
| 1113 | ["Class Hierarchy from TAGS" cperl-tags-hier-init t] | 1115 | ["Insert spaces if needed" cperl-find-bad-style t] |
| 1114 | ;;["Update classes" (cperl-tags-hier-init t) tags-table-list] | 1116 | ["Class Hierarchy from TAGS" cperl-tags-hier-init t] |
| 1115 | ["CPerl pretty print (exprmntl)" cperl-ps-print | 1117 | ;;["Update classes" (cperl-tags-hier-init t) tags-table-list] |
| 1116 | (fboundp 'ps-extend-face-list)] | 1118 | ["CPerl pretty print (exprmntl)" cperl-ps-print |
| 1117 | ["Imenu on info" cperl-imenu-on-info (featurep 'imenu)] | 1119 | (fboundp 'ps-extend-face-list)] |
| 1118 | ("Tags" | 1120 | ["Imenu on info" cperl-imenu-on-info (featurep 'imenu)] |
| 1121 | ("Tags" | ||
| 1119 | ;;; ["Create tags for current file" cperl-etags t] | 1122 | ;;; ["Create tags for current file" cperl-etags t] |
| 1120 | ;;; ["Add tags for current file" (cperl-etags t) t] | 1123 | ;;; ["Add tags for current file" (cperl-etags t) t] |
| 1121 | ;;; ["Create tags for Perl files in directory" (cperl-etags nil t) t] | 1124 | ;;; ["Create tags for Perl files in directory" (cperl-etags nil t) t] |
| @@ -1125,57 +1128,57 @@ the faces: please specify bold, italic, underline, shadow and box.) | |||
| 1125 | ;;; ["Add tags for Perl files in (sub)directories" | 1128 | ;;; ["Add tags for Perl files in (sub)directories" |
| 1126 | ;;; (cperl-etags t 'recursive) t]) | 1129 | ;;; (cperl-etags t 'recursive) t]) |
| 1127 | ;;;; cperl-write-tags (&optional file erase recurse dir inbuffer) | 1130 | ;;;; cperl-write-tags (&optional file erase recurse dir inbuffer) |
| 1128 | ["Create tags for current file" (cperl-write-tags nil t) t] | 1131 | ["Create tags for current file" (cperl-write-tags nil t) t] |
| 1129 | ["Add tags for current file" (cperl-write-tags) t] | 1132 | ["Add tags for current file" (cperl-write-tags) t] |
| 1130 | ["Create tags for Perl files in directory" | 1133 | ["Create tags for Perl files in directory" |
| 1131 | (cperl-write-tags nil t nil t) t] | 1134 | (cperl-write-tags nil t nil t) t] |
| 1132 | ["Add tags for Perl files in directory" | 1135 | ["Add tags for Perl files in directory" |
| 1133 | (cperl-write-tags nil nil nil t) t] | 1136 | (cperl-write-tags nil nil nil t) t] |
| 1134 | ["Create tags for Perl files in (sub)directories" | 1137 | ["Create tags for Perl files in (sub)directories" |
| 1135 | (cperl-write-tags nil t t t) t] | 1138 | (cperl-write-tags nil t t t) t] |
| 1136 | ["Add tags for Perl files in (sub)directories" | 1139 | ["Add tags for Perl files in (sub)directories" |
| 1137 | (cperl-write-tags nil nil t t) t])) | 1140 | (cperl-write-tags nil nil t t) t])) |
| 1138 | ("Perl docs" | 1141 | ("Perl docs" |
| 1139 | ["Define word at point" imenu-go-find-at-position | 1142 | ["Define word at point" imenu-go-find-at-position |
| 1140 | (fboundp 'imenu-go-find-at-position)] | 1143 | (fboundp 'imenu-go-find-at-position)] |
| 1141 | ["Help on function" cperl-info-on-command t] | 1144 | ["Help on function" cperl-info-on-command t] |
| 1142 | ["Help on function at point" cperl-info-on-current-command t] | 1145 | ["Help on function at point" cperl-info-on-current-command t] |
| 1143 | ["Help on symbol at point" cperl-get-help t] | 1146 | ["Help on symbol at point" cperl-get-help t] |
| 1144 | ["Perldoc" cperl-perldoc t] | 1147 | ["Perldoc" cperl-perldoc t] |
| 1145 | ["Perldoc on word at point" cperl-perldoc-at-point t] | 1148 | ["Perldoc on word at point" cperl-perldoc-at-point t] |
| 1146 | ["View manpage of POD in this file" cperl-pod-to-manpage t] | 1149 | ["View manpage of POD in this file" cperl-pod-to-manpage t] |
| 1147 | ["Auto-help on" cperl-lazy-install | 1150 | ["Auto-help on" cperl-lazy-install |
| 1148 | (and (fboundp 'run-with-idle-timer) | 1151 | (and (fboundp 'run-with-idle-timer) |
| 1149 | (not cperl-lazy-installed))] | 1152 | (not cperl-lazy-installed))] |
| 1150 | ["Auto-help off" (eval '(cperl-lazy-unstall)) | 1153 | ["Auto-help off" (eval '(cperl-lazy-unstall)) |
| 1151 | (and (fboundp 'run-with-idle-timer) | 1154 | (and (fboundp 'run-with-idle-timer) |
| 1152 | cperl-lazy-installed)]) | 1155 | cperl-lazy-installed)]) |
| 1153 | ("Toggle..." | 1156 | ("Toggle..." |
| 1154 | ["Auto newline" cperl-toggle-auto-newline t] | 1157 | ["Auto newline" cperl-toggle-auto-newline t] |
| 1155 | ["Electric parens" cperl-toggle-electric t] | 1158 | ["Electric parens" cperl-toggle-electric t] |
| 1156 | ["Electric keywords" cperl-toggle-abbrev t] | 1159 | ["Electric keywords" cperl-toggle-abbrev t] |
| 1157 | ["Fix whitespace on indent" cperl-toggle-construct-fix t] | 1160 | ["Fix whitespace on indent" cperl-toggle-construct-fix t] |
| 1158 | ["Auto fill" auto-fill-mode t]) | 1161 | ["Auto fill" auto-fill-mode t]) |
| 1159 | ("Indent styles..." | 1162 | ("Indent styles..." |
| 1160 | ["CPerl" (cperl-set-style "CPerl") t] | 1163 | ["CPerl" (cperl-set-style "CPerl") t] |
| 1161 | ["PerlStyle" (cperl-set-style "PerlStyle") t] | 1164 | ["PerlStyle" (cperl-set-style "PerlStyle") t] |
| 1162 | ["GNU" (cperl-set-style "GNU") t] | 1165 | ["GNU" (cperl-set-style "GNU") t] |
| 1163 | ["C++" (cperl-set-style "C++") t] | 1166 | ["C++" (cperl-set-style "C++") t] |
| 1164 | ["FSF" (cperl-set-style "FSF") t] | 1167 | ["FSF" (cperl-set-style "FSF") t] |
| 1165 | ["BSD" (cperl-set-style "BSD") t] | 1168 | ["BSD" (cperl-set-style "BSD") t] |
| 1166 | ["Whitesmith" (cperl-set-style "Whitesmith") t] | 1169 | ["Whitesmith" (cperl-set-style "Whitesmith") t] |
| 1167 | ["Current" (cperl-set-style "Current") t] | 1170 | ["Current" (cperl-set-style "Current") t] |
| 1168 | ["Memorized" (cperl-set-style-back) cperl-old-style]) | 1171 | ["Memorized" (cperl-set-style-back) cperl-old-style]) |
| 1169 | ("Micro-docs" | 1172 | ("Micro-docs" |
| 1170 | ["Tips" (describe-variable 'cperl-tips) t] | 1173 | ["Tips" (describe-variable 'cperl-tips) t] |
| 1171 | ["Problems" (describe-variable 'cperl-problems) t] | 1174 | ["Problems" (describe-variable 'cperl-problems) t] |
| 1172 | ["Speed" (describe-variable 'cperl-speed) t] | 1175 | ["Speed" (describe-variable 'cperl-speed) t] |
| 1173 | ["Praise" (describe-variable 'cperl-praise) t] | 1176 | ["Praise" (describe-variable 'cperl-praise) t] |
| 1174 | ["Faces" (describe-variable 'cperl-tips-faces) t] | 1177 | ["Faces" (describe-variable 'cperl-tips-faces) t] |
| 1175 | ["CPerl mode" (describe-function 'cperl-mode) t] | 1178 | ["CPerl mode" (describe-function 'cperl-mode) t] |
| 1176 | ["CPerl version" | 1179 | ["CPerl version" |
| 1177 | (message "The version of master-file for this CPerl is %s-emacs" | 1180 | (message "The version of master-file for this CPerl is %s-emacs" |
| 1178 | cperl-version) t])))) | 1181 | cperl-version) t])))) |
| 1179 | (error nil)) | 1182 | (error nil)) |
| 1180 | 1183 | ||
| 1181 | (autoload 'c-macro-expand "cmacexp" | 1184 | (autoload 'c-macro-expand "cmacexp" |
| @@ -1224,14 +1227,15 @@ The expansion is entirely correct because it uses the C preprocessor." | |||
| 1224 | (modify-syntax-entry ?| "." cperl-mode-syntax-table) | 1227 | (modify-syntax-entry ?| "." cperl-mode-syntax-table) |
| 1225 | (setq cperl-string-syntax-table (copy-syntax-table cperl-mode-syntax-table)) | 1228 | (setq cperl-string-syntax-table (copy-syntax-table cperl-mode-syntax-table)) |
| 1226 | (modify-syntax-entry ?$ "." cperl-string-syntax-table) | 1229 | (modify-syntax-entry ?$ "." cperl-string-syntax-table) |
| 1227 | (modify-syntax-entry ?# "." cperl-string-syntax-table) ; (?# comment ) | 1230 | (modify-syntax-entry ?# "." cperl-string-syntax-table)) ; (?# comment ) |
| 1228 | ) | ||
| 1229 | 1231 | ||
| 1230 | 1232 | ||
| 1231 | 1233 | ||
| 1232 | (defvar cperl-faces-init nil) | 1234 | (defvar cperl-faces-init nil) |
| 1233 | ;; Fix for msb.el | 1235 | ;; Fix for msb.el |
| 1234 | (defvar cperl-msb-fixed nil) | 1236 | (defvar cperl-msb-fixed nil) |
| 1237 | (defvar cperl-use-major-mode 'cperl-mode) | ||
| 1238 | |||
| 1235 | ;;;###autoload | 1239 | ;;;###autoload |
| 1236 | (defun cperl-mode () | 1240 | (defun cperl-mode () |
| 1237 | "Major mode for editing Perl code. | 1241 | "Major mode for editing Perl code. |
| @@ -1337,7 +1341,7 @@ beginning of the region at the start of construction, and make region | |||
| 1337 | span the needed amount of lines. | 1341 | span the needed amount of lines. |
| 1338 | 1342 | ||
| 1339 | Variables `cperl-pod-here-scan', `cperl-pod-here-fontify', | 1343 | Variables `cperl-pod-here-scan', `cperl-pod-here-fontify', |
| 1340 | `cperl-pod-face', `cperl-pod-head-face' control processing of pod and | 1344 | `cperl-pod-face', `cperl-pod-head-face' control processing of POD and |
| 1341 | here-docs sections. With capable Emaxen results of scan are used | 1345 | here-docs sections. With capable Emaxen results of scan are used |
| 1342 | for indentation too, otherwise they are used for highlighting only. | 1346 | for indentation too, otherwise they are used for highlighting only. |
| 1343 | 1347 | ||
| @@ -1412,7 +1416,7 @@ or as help on variables `cperl-tips', `cperl-problems', | |||
| 1412 | (cperl-define-key "\C-hf" 'cperl-info-on-current-command [(control h) f]) | 1416 | (cperl-define-key "\C-hf" 'cperl-info-on-current-command [(control h) f]) |
| 1413 | (cperl-define-key "\C-c\C-hf" 'cperl-info-on-command | 1417 | (cperl-define-key "\C-c\C-hf" 'cperl-info-on-command |
| 1414 | [(control c) (control h) f]))) | 1418 | [(control c) (control h) f]))) |
| 1415 | (setq major-mode 'cperl-mode) | 1419 | (setq major-mode cperl-use-major-mode) |
| 1416 | (setq mode-name "CPerl") | 1420 | (setq mode-name "CPerl") |
| 1417 | (if (not cperl-mode-abbrev-table) | 1421 | (if (not cperl-mode-abbrev-table) |
| 1418 | (let ((prev-a-c abbrevs-changed)) | 1422 | (let ((prev-a-c abbrevs-changed)) |
| @@ -1502,9 +1506,9 @@ or as help on variables `cperl-tips', `cperl-problems', | |||
| 1502 | ;; Fix broken font-lock: | 1506 | ;; Fix broken font-lock: |
| 1503 | (or (boundp 'font-lock-unfontify-region-function) | 1507 | (or (boundp 'font-lock-unfontify-region-function) |
| 1504 | (set 'font-lock-unfontify-region-function | 1508 | (set 'font-lock-unfontify-region-function |
| 1505 | 'font-lock-default-unfontify-region)) | 1509 | 'font-lock-default-unfontify-region)) |
| 1506 | (make-local-variable 'font-lock-unfontify-region-function) | 1510 | (make-local-variable 'font-lock-unfontify-region-function) |
| 1507 | (set 'font-lock-unfontify-region-function | 1511 | (set 'font-lock-unfontify-region-function ; not present with old Emacs |
| 1508 | 'cperl-font-lock-unfontify-region-function) | 1512 | 'cperl-font-lock-unfontify-region-function) |
| 1509 | (make-local-variable 'cperl-syntax-done-to) | 1513 | (make-local-variable 'cperl-syntax-done-to) |
| 1510 | ;; Another bug: unless font-lock-syntactic-keywords, font-lock | 1514 | ;; Another bug: unless font-lock-syntactic-keywords, font-lock |
| @@ -1517,8 +1521,17 @@ or as help on variables `cperl-tips', `cperl-problems', | |||
| 1517 | '(t (cperl-fontify-syntaxically)) | 1521 | '(t (cperl-fontify-syntaxically)) |
| 1518 | '(t))))) | 1522 | '(t))))) |
| 1519 | (make-local-variable 'cperl-old-style) | 1523 | (make-local-variable 'cperl-old-style) |
| 1520 | (set (make-local-variable 'normal-auto-fill-function) | 1524 | (if (boundp 'normal-auto-fill-function) ; 19.33 and later |
| 1521 | #'cperl-do-auto-fill) | 1525 | (set (make-local-variable 'normal-auto-fill-function) |
| 1526 | 'cperl-do-auto-fill) ; RMS has it as #'cperl-do-auto-fill ??? | ||
| 1527 | (or (fboundp 'cperl-old-auto-fill-mode) | ||
| 1528 | (progn | ||
| 1529 | (fset 'cperl-old-auto-fill-mode (symbol-function 'auto-fill-mode)) | ||
| 1530 | (defun auto-fill-mode (&optional arg) | ||
| 1531 | (interactive "P") | ||
| 1532 | (eval '(cperl-old-auto-fill-mode arg)) ; Avoid a warning | ||
| 1533 | (and auto-fill-function (memq major-mode '(perl-mode cperl-mode)) | ||
| 1534 | (setq auto-fill-function 'cperl-do-auto-fill)))))) | ||
| 1522 | (if (cperl-enable-font-lock) | 1535 | (if (cperl-enable-font-lock) |
| 1523 | (if (cperl-val 'cperl-font-lock) | 1536 | (if (cperl-val 'cperl-font-lock) |
| 1524 | (progn (or cperl-faces-init (cperl-init-faces)) | 1537 | (progn (or cperl-faces-init (cperl-init-faces)) |
| @@ -1531,10 +1544,7 @@ or as help on variables `cperl-tips', `cperl-problems', | |||
| 1531 | (run-hooks 'cperl-mode-hook) | 1544 | (run-hooks 'cperl-mode-hook) |
| 1532 | ;; After hooks since fontification will break this | 1545 | ;; After hooks since fontification will break this |
| 1533 | (if cperl-pod-here-scan | 1546 | (if cperl-pod-here-scan |
| 1534 | (or ;;(and (boundp 'font-lock-mode) | 1547 | (or cperl-syntaxify-by-font-lock |
| 1535 | ;; (eval 'font-lock-mode) ; Avoid warning | ||
| 1536 | ;; (boundp 'font-lock-hot-pass) ; Newer font-lock | ||
| 1537 | cperl-syntaxify-by-font-lock ;;) | ||
| 1538 | (progn (or cperl-faces-init (cperl-init-faces-weak)) | 1548 | (progn (or cperl-faces-init (cperl-init-faces-weak)) |
| 1539 | (cperl-find-pods-heres))))) | 1549 | (cperl-find-pods-heres))))) |
| 1540 | 1550 | ||
| @@ -1546,10 +1556,10 @@ or as help on variables `cperl-tips', `cperl-problems', | |||
| 1546 | (if (consp gud-perldb-history) | 1556 | (if (consp gud-perldb-history) |
| 1547 | (car gud-perldb-history) | 1557 | (car gud-perldb-history) |
| 1548 | (concat "perl " ;;(file-name-nondirectory | 1558 | (concat "perl " ;;(file-name-nondirectory |
| 1549 | ;; I have problems | 1559 | ;; I have problems |
| 1550 | ;; in OS/2 | 1560 | ;; in OS/2 |
| 1551 | ;; otherwise | 1561 | ;; otherwise |
| 1552 | (buffer-file-name))) | 1562 | (buffer-file-name))) |
| 1553 | nil nil | 1563 | nil nil |
| 1554 | '(gud-perldb-history . 1)))) | 1564 | '(gud-perldb-history . 1)))) |
| 1555 | 1565 | ||
| @@ -1675,7 +1685,7 @@ char is \"{\", insert extra newline before only if | |||
| 1675 | (setq last-command-char ?\{) | 1685 | (setq last-command-char ?\{) |
| 1676 | (cperl-electric-lbrace arg insertpos)) | 1686 | (cperl-electric-lbrace arg insertpos)) |
| 1677 | (forward-char 1)) | 1687 | (forward-char 1)) |
| 1678 | ;: Check whether we close something "usual" with `}' | 1688 | ;; Check whether we close something "usual" with `}' |
| 1679 | (if (and (eq last-command-char ?\}) | 1689 | (if (and (eq last-command-char ?\}) |
| 1680 | (not | 1690 | (not |
| 1681 | (condition-case nil | 1691 | (condition-case nil |
| @@ -1725,17 +1735,17 @@ char is \"{\", insert extra newline before only if | |||
| 1725 | (defun cperl-electric-lbrace (arg &optional end) | 1735 | (defun cperl-electric-lbrace (arg &optional end) |
| 1726 | "Insert character, correct line's indentation, correct quoting by space." | 1736 | "Insert character, correct line's indentation, correct quoting by space." |
| 1727 | (interactive "P") | 1737 | (interactive "P") |
| 1728 | (let (pos after | 1738 | (let ((cperl-brace-recursing t) |
| 1729 | (cperl-brace-recursing t) | 1739 | (cperl-auto-newline cperl-auto-newline) |
| 1730 | (cperl-auto-newline cperl-auto-newline) | 1740 | (other-end (or end |
| 1731 | (other-end (or end | 1741 | (if (and cperl-electric-parens-mark |
| 1732 | (if (and cperl-electric-parens-mark | 1742 | (cperl-mark-active) |
| 1733 | (cperl-mark-active) | 1743 | (> (mark) (point))) |
| 1734 | (> (mark) (point))) | 1744 | (save-excursion |
| 1735 | (save-excursion | 1745 | (goto-char (mark)) |
| 1736 | (goto-char (mark)) | 1746 | (point-marker)) |
| 1737 | (point-marker)) | 1747 | nil))) |
| 1738 | nil)))) | 1748 | pos after) |
| 1739 | (and (cperl-val 'cperl-electric-lbrace-space) | 1749 | (and (cperl-val 'cperl-electric-lbrace-space) |
| 1740 | (eq (preceding-char) ?$) | 1750 | (eq (preceding-char) ?$) |
| 1741 | (save-excursion | 1751 | (save-excursion |
| @@ -1768,9 +1778,9 @@ char is \"{\", insert extra newline before only if | |||
| 1768 | (other-end (if (and cperl-electric-parens-mark | 1778 | (other-end (if (and cperl-electric-parens-mark |
| 1769 | (cperl-mark-active) | 1779 | (cperl-mark-active) |
| 1770 | (> (mark) (point))) | 1780 | (> (mark) (point))) |
| 1771 | (save-excursion | 1781 | (save-excursion |
| 1772 | (goto-char (mark)) | 1782 | (goto-char (mark)) |
| 1773 | (point-marker)) | 1783 | (point-marker)) |
| 1774 | nil))) | 1784 | nil))) |
| 1775 | (if (and (cperl-val 'cperl-electric-parens) | 1785 | (if (and (cperl-val 'cperl-electric-parens) |
| 1776 | (memq last-command-char | 1786 | (memq last-command-char |
| @@ -1822,9 +1832,9 @@ If not, or if we are not at the end of marking range, would self-insert." | |||
| 1822 | (insert (make-string | 1832 | (insert (make-string |
| 1823 | (prefix-numeric-value arg) | 1833 | (prefix-numeric-value arg) |
| 1824 | (cdr (assoc last-command-char '((?\} . ?\{) | 1834 | (cdr (assoc last-command-char '((?\} . ?\{) |
| 1825 | (?\] . ?\[) | 1835 | (?\] . ?\[) |
| 1826 | (?\) . ?\() | 1836 | (?\) . ?\() |
| 1827 | (?\> . ?\<)))))) | 1837 | (?\> . ?\<)))))) |
| 1828 | (goto-char (1+ p))) | 1838 | (goto-char (1+ p))) |
| 1829 | (self-insert-command (prefix-numeric-value arg))))) | 1839 | (self-insert-command (prefix-numeric-value arg))))) |
| 1830 | 1840 | ||
| @@ -1879,8 +1889,7 @@ to nil." | |||
| 1879 | (insert "\n}") | 1889 | (insert "\n}") |
| 1880 | (and do (insert " while ();"))) | 1890 | (and do (insert " while ();"))) |
| 1881 | (t | 1891 | (t |
| 1882 | (insert (if do " {\n} while ();" " () {\n}"))) | 1892 | (insert (if do " {\n} while ();" " () {\n}")))) |
| 1883 | ) | ||
| 1884 | (or (looking-at "[ \t]\\|$") (insert " ")) | 1893 | (or (looking-at "[ \t]\\|$") (insert " ")) |
| 1885 | (cperl-indent-line) | 1894 | (cperl-indent-line) |
| 1886 | (if dollar (progn (search-backward "$") | 1895 | (if dollar (progn (search-backward "$") |
| @@ -1943,7 +1952,7 @@ to nil." | |||
| 1943 | (save-excursion | 1952 | (save-excursion |
| 1944 | (forward-char -1) | 1953 | (forward-char -1) |
| 1945 | (re-search-backward "\\(\\`\n?\\|\n\n\\)=head1\\>" | 1954 | (re-search-backward "\\(\\`\n?\\|\n\n\\)=head1\\>" |
| 1946 | nil t)))) ; Only one | 1955 | nil t)))) ; Only one |
| 1947 | (progn | 1956 | (progn |
| 1948 | (forward-word 1) | 1957 | (forward-word 1) |
| 1949 | (setq name (file-name-sans-extension | 1958 | (setq name (file-name-sans-extension |
| @@ -2000,8 +2009,7 @@ to nil." | |||
| 2000 | (cperl-indent-line) | 2009 | (cperl-indent-line) |
| 2001 | (insert "\n\n}")) | 2010 | (insert "\n\n}")) |
| 2002 | (t | 2011 | (t |
| 2003 | (insert " {\n\n}")) | 2012 | (insert " {\n\n}"))) |
| 2004 | ) | ||
| 2005 | (or (looking-at "[ \t]\\|$") (insert " ")) | 2013 | (or (looking-at "[ \t]\\|$") (insert " ")) |
| 2006 | (cperl-indent-line) | 2014 | (cperl-indent-line) |
| 2007 | (forward-line -1) | 2015 | (forward-line -1) |
| @@ -2021,7 +2029,7 @@ If in POD, insert appropriate lines." | |||
| 2021 | (if (and ; Check if we need to split: | 2029 | (if (and ; Check if we need to split: |
| 2022 | ; i.e., on a boundary and inside "{...}" | 2030 | ; i.e., on a boundary and inside "{...}" |
| 2023 | (save-excursion (cperl-to-comment-or-eol) | 2031 | (save-excursion (cperl-to-comment-or-eol) |
| 2024 | (>= (point) pos)) ; Not in a comment | 2032 | (>= (point) pos)) ; Not in a comment |
| 2025 | (or (save-excursion | 2033 | (or (save-excursion |
| 2026 | (skip-chars-backward " \t" beg) | 2034 | (skip-chars-backward " \t" beg) |
| 2027 | (forward-char -1) | 2035 | (forward-char -1) |
| @@ -2058,7 +2066,7 @@ If in POD, insert appropriate lines." | |||
| 2058 | (cperl-indent-line) | 2066 | (cperl-indent-line) |
| 2059 | (beginning-of-line) | 2067 | (beginning-of-line) |
| 2060 | (or (looking-at "[ \t]*}[,; \t]*$") ; If there is a statement | 2068 | (or (looking-at "[ \t]*}[,; \t]*$") ; If there is a statement |
| 2061 | ; after, move it to separate line | 2069 | ; after, move it to separate line |
| 2062 | (progn | 2070 | (progn |
| 2063 | (end-of-line) | 2071 | (end-of-line) |
| 2064 | (search-backward "}" beg) | 2072 | (search-backward "}" beg) |
| @@ -2077,7 +2085,7 @@ If in POD, insert appropriate lines." | |||
| 2077 | (save-excursion | 2085 | (save-excursion |
| 2078 | (skip-chars-backward " \t") | 2086 | (skip-chars-backward " \t") |
| 2079 | (eq (preceding-char) ?\)))) ; Probably if () {} group | 2087 | (eq (preceding-char) ?\)))) ; Probably if () {} group |
| 2080 | ; with an extra newline. | 2088 | ; with an extra newline. |
| 2081 | (forward-line 2) | 2089 | (forward-line 2) |
| 2082 | (cperl-indent-line)) | 2090 | (cperl-indent-line)) |
| 2083 | ((save-excursion ; In POD header | 2091 | ((save-excursion ; In POD header |
| @@ -2129,10 +2137,11 @@ If in POD, insert appropriate lines." | |||
| 2129 | (defun cperl-electric-terminator (arg) | 2137 | (defun cperl-electric-terminator (arg) |
| 2130 | "Insert character and correct line's indentation." | 2138 | "Insert character and correct line's indentation." |
| 2131 | (interactive "P") | 2139 | (interactive "P") |
| 2132 | (let (insertpos (end (point)) | 2140 | (let ((end (point)) |
| 2133 | (auto (and cperl-auto-newline | 2141 | (auto (and cperl-auto-newline |
| 2134 | (or (not (eq last-command-char ?:)) | 2142 | (or (not (eq last-command-char ?:)) |
| 2135 | cperl-auto-newline-after-colon)))) | 2143 | cperl-auto-newline-after-colon))) |
| 2144 | insertpos) | ||
| 2136 | (if (and ;;(not arg) | 2145 | (if (and ;;(not arg) |
| 2137 | (eolp) | 2146 | (eolp) |
| 2138 | (not (save-excursion | 2147 | (not (save-excursion |
| @@ -2251,9 +2260,9 @@ The relative indentation among the lines of the expression are preserved." | |||
| 2251 | (defun cperl-indent-line (&optional parse-data) | 2260 | (defun cperl-indent-line (&optional parse-data) |
| 2252 | "Indent current line as Perl code. | 2261 | "Indent current line as Perl code. |
| 2253 | Return the amount the indentation changed by." | 2262 | Return the amount the indentation changed by." |
| 2254 | (let (indent i beg shift-amt | 2263 | (let ((case-fold-search nil) |
| 2255 | (case-fold-search nil) | 2264 | (pos (- (point-max) (point))) |
| 2256 | (pos (- (point-max) (point)))) | 2265 | indent i beg shift-amt) |
| 2257 | (setq indent (cperl-calculate-indent parse-data) | 2266 | (setq indent (cperl-calculate-indent parse-data) |
| 2258 | i indent) | 2267 | i indent) |
| 2259 | (beginning-of-line) | 2268 | (beginning-of-line) |
| @@ -2331,7 +2340,7 @@ Return the amount the indentation changed by." | |||
| 2331 | (or state (setq state (parse-partial-sexp start start-point -1 nil start-state))) | 2340 | (or state (setq state (parse-partial-sexp start start-point -1 nil start-state))) |
| 2332 | (list start state depth prestart)))) | 2341 | (list start state depth prestart)))) |
| 2333 | 2342 | ||
| 2334 | (defun cperl-block-p () ; Do not C-M-q ! One string contains ";" ! | 2343 | (defun cperl-block-p () ; Do not C-M-q ! One string contains ";" ! |
| 2335 | ;; Positions is before ?\{. Checks whether it starts a block. | 2344 | ;; Positions is before ?\{. Checks whether it starts a block. |
| 2336 | ;; No save-excursion! | 2345 | ;; No save-excursion! |
| 2337 | (cperl-backward-to-noncomment (point-min)) | 2346 | (cperl-backward-to-noncomment (point-min)) |
| @@ -2368,134 +2377,125 @@ and closing parentheses and brackets." | |||
| 2368 | (not (get-text-property (point) 'indentable))) | 2377 | (not (get-text-property (point) 'indentable))) |
| 2369 | ;; before start of POD - whitespace found since do not have 'pod! | 2378 | ;; before start of POD - whitespace found since do not have 'pod! |
| 2370 | (and (looking-at "[ \t]*\n=") | 2379 | (and (looking-at "[ \t]*\n=") |
| 2371 | (error "Spaces before pod section!")) | 2380 | (error "Spaces before POD section!")) |
| 2372 | (and (not cperl-indent-left-aligned-comments) | 2381 | (and (not cperl-indent-left-aligned-comments) |
| 2373 | (looking-at "^#"))) | 2382 | (looking-at "^#"))) |
| 2374 | nil | 2383 | nil |
| 2375 | (beginning-of-line) | 2384 | (beginning-of-line) |
| 2376 | (let ((indent-point (point)) | 2385 | (let ((indent-point (point)) |
| 2377 | (char-after (save-excursion | 2386 | (char-after (save-excursion |
| 2378 | (skip-chars-forward " \t") | 2387 | (skip-chars-forward " \t") |
| 2379 | (following-char))) | 2388 | (following-char))) |
| 2380 | (in-pod (get-text-property (point) 'in-pod)) | 2389 | (in-pod (get-text-property (point) 'in-pod)) |
| 2381 | (pre-indent-point (point)) | 2390 | (pre-indent-point (point)) |
| 2382 | p prop look-prop is-block delim) | 2391 | p prop look-prop is-block delim) |
| 2383 | (cond | 2392 | (cond |
| 2384 | (in-pod | 2393 | (in-pod |
| 2385 | ;; In the verbatim part, probably code example. What to do??? | 2394 | ;; In the verbatim part, probably code example. What to do??? |
| 2386 | ) | 2395 | ) |
| 2387 | (t | 2396 | (t |
| 2388 | (save-excursion | 2397 | (save-excursion |
| 2389 | ;; Not in pod | 2398 | ;; Not in POD |
| 2390 | (cperl-backward-to-noncomment nil) | 2399 | (cperl-backward-to-noncomment nil) |
| 2391 | (setq p (max (point-min) (1- (point))) | 2400 | (setq p (max (point-min) (1- (point))) |
| 2392 | prop (get-text-property p 'syntax-type) | 2401 | prop (get-text-property p 'syntax-type) |
| 2393 | look-prop (or (nth 1 (assoc prop cperl-look-for-prop)) | 2402 | look-prop (or (nth 1 (assoc prop cperl-look-for-prop)) |
| 2394 | 'syntax-type)) | 2403 | 'syntax-type)) |
| 2395 | (if (memq prop '(pod here-doc format here-doc-delim)) | 2404 | (if (memq prop '(pod here-doc format here-doc-delim)) |
| 2405 | (progn | ||
| 2406 | (goto-char (or (previous-single-property-change p look-prop) | ||
| 2407 | (point-min))) | ||
| 2408 | (beginning-of-line) | ||
| 2409 | (setq pre-indent-point (point))))))) | ||
| 2410 | (goto-char pre-indent-point) | ||
| 2411 | (let* ((case-fold-search nil) | ||
| 2412 | (s-s (cperl-get-state (car parse-data) (nth 1 parse-data))) | ||
| 2413 | (start (or (nth 2 parse-data) | ||
| 2414 | (nth 0 s-s))) | ||
| 2415 | (state (nth 1 s-s)) | ||
| 2416 | (containing-sexp (car (cdr state))) | ||
| 2417 | old-indent) | ||
| 2418 | (if (and | ||
| 2419 | ;;containing-sexp ;; We are buggy at toplevel :-( | ||
| 2420 | parse-data) | ||
| 2396 | (progn | 2421 | (progn |
| 2397 | (goto-char (or (previous-single-property-change p look-prop) | 2422 | (setcar parse-data pre-indent-point) |
| 2398 | (point-min))) | 2423 | (setcar (cdr parse-data) state) |
| 2399 | (beginning-of-line) | 2424 | (or (nth 2 parse-data) |
| 2400 | (setq pre-indent-point (point))))))) | 2425 | (setcar (cddr parse-data) start)) |
| 2401 | (goto-char pre-indent-point) | 2426 | ;; Before this point: end of statement |
| 2402 | (let* ((case-fold-search nil) | 2427 | (setq old-indent (nth 3 parse-data)))) |
| 2403 | (s-s (cperl-get-state (car parse-data) (nth 1 parse-data))) | 2428 | (cond ((get-text-property (point) 'indentable) |
| 2404 | (start (or (nth 2 parse-data) | 2429 | ;; indent to just after the surrounding open, |
| 2405 | (nth 0 s-s))) | 2430 | ;; skip blanks if we do not close the expression. |
| 2406 | (state (nth 1 s-s)) | 2431 | (goto-char (1+ (previous-single-property-change (point) 'indentable))) |
| 2407 | (containing-sexp (car (cdr state))) | 2432 | (or (memq char-after (append ")]}" nil)) |
| 2408 | old-indent) | 2433 | (looking-at "[ \t]*\\(#\\|$\\)") |
| 2409 | (if (and | 2434 | (skip-chars-forward " \t")) |
| 2410 | ;;containing-sexp ;; We are buggy at toplevel :-( | 2435 | (current-column)) |
| 2411 | parse-data) | 2436 | ((or (nth 3 state) (nth 4 state)) |
| 2412 | (progn | 2437 | ;; return nil or t if should not change this line |
| 2413 | (setcar parse-data pre-indent-point) | 2438 | (nth 4 state)) |
| 2414 | (setcar (cdr parse-data) state) | 2439 | ;; XXXX Do we need to special-case this? |
| 2415 | (or (nth 2 parse-data) | 2440 | ((null containing-sexp) |
| 2416 | (setcar (cddr parse-data) start)) | 2441 | ;; Line is at top level. May be data or function definition, |
| 2417 | ;; Before this point: end of statement | 2442 | ;; or may be function argument declaration. |
| 2418 | (setq old-indent (nth 3 parse-data)))) | 2443 | ;; Indent like the previous top level line |
| 2419 | (cond ((get-text-property (point) 'indentable) | 2444 | ;; unless that ends in a closeparen without semicolon, |
| 2420 | ;; indent to just after the surrounding open, | 2445 | ;; in which case this line is the first argument decl. |
| 2421 | ;; skip blanks if we do not close the expression. | 2446 | (skip-chars-forward " \t") |
| 2422 | (goto-char (1+ (previous-single-property-change (point) 'indentable))) | 2447 | (+ (save-excursion |
| 2423 | (or (memq char-after (append ")]}" nil)) | 2448 | (goto-char start) |
| 2424 | (looking-at "[ \t]*\\(#\\|$\\)") | 2449 | (- (current-indentation) |
| 2425 | (skip-chars-forward " \t")) | 2450 | (if (nth 2 s-s) cperl-indent-level 0))) |
| 2426 | (current-column)) | 2451 | (if (= char-after ?{) cperl-continued-brace-offset 0) |
| 2427 | ((or (nth 3 state) (nth 4 state)) | 2452 | (progn |
| 2428 | ;; return nil or t if should not change this line | 2453 | (cperl-backward-to-noncomment (or old-indent (point-min))) |
| 2429 | (nth 4 state)) | 2454 | ;; Look at previous line that's at column 0 |
| 2430 | ;; XXXX Do we need to special-case this? | 2455 | ;; to determine whether we are in top-level decls |
| 2431 | ((null containing-sexp) | 2456 | ;; or function's arg decls. Set basic-indent accordingly. |
| 2432 | ;; Line is at top level. May be data or function definition, | 2457 | ;; Now add a little if this is a continuation line. |
| 2433 | ;; or may be function argument declaration. | 2458 | (if (or (bobp) |
| 2434 | ;; Indent like the previous top level line | 2459 | (eq (point) old-indent) ; old-indent was at comment |
| 2435 | ;; unless that ends in a closeparen without semicolon, | 2460 | (eq (preceding-char) ?\;) |
| 2436 | ;; in which case this line is the first argument decl. | 2461 | ;; Had ?\) too |
| 2437 | (skip-chars-forward " \t") | 2462 | (and (eq (preceding-char) ?\}) |
| 2438 | (+ (save-excursion | 2463 | (cperl-after-block-and-statement-beg |
| 2439 | (goto-char start) | 2464 | (point-min))) ; Was start - too close |
| 2440 | (- (current-indentation) | 2465 | (memq char-after (append ")]}" nil)) |
| 2441 | (if (nth 2 s-s) cperl-indent-level 0))) | 2466 | (and (eq (preceding-char) ?\:) ; label |
| 2442 | (if (= char-after ?{) cperl-continued-brace-offset 0) | 2467 | (progn |
| 2443 | (progn | 2468 | (forward-sexp -1) |
| 2444 | (cperl-backward-to-noncomment (or old-indent (point-min))) | 2469 | (skip-chars-backward " \t") |
| 2445 | ;; Look at previous line that's at column 0 | 2470 | (looking-at "[ \t]*[a-zA-Z_][a-zA-Z_0-9]*[ \t]*:")))) |
| 2446 | ;; to determine whether we are in top-level decls | 2471 | (progn |
| 2447 | ;; or function's arg decls. Set basic-indent accordingly. | 2472 | (if (and parse-data |
| 2448 | ;; Now add a little if this is a continuation line. | 2473 | (not (eq char-after ?\C-j))) |
| 2449 | (if (or (bobp) | 2474 | (setcdr (cddr parse-data) |
| 2450 | (eq (point) old-indent) ; old-indent was at comment | 2475 | (list pre-indent-point))) |
| 2451 | (eq (preceding-char) ?\;) | 2476 | 0) |
| 2452 | ;; Had ?\) too | 2477 | cperl-continued-statement-offset)))) |
| 2453 | (and (eq (preceding-char) ?\}) | 2478 | ((not |
| 2454 | (cperl-after-block-and-statement-beg | 2479 | (or (setq is-block |
| 2455 | (point-min))) ; Was start - too close | 2480 | (and (setq delim (= (char-after containing-sexp) ?{)) |
| 2456 | (memq char-after (append ")]}" nil)) | 2481 | (save-excursion ; Is it a hash? |
| 2457 | (and (eq (preceding-char) ?\:) ; label | 2482 | (goto-char containing-sexp) |
| 2458 | (progn | 2483 | (cperl-block-p)))) |
| 2459 | (forward-sexp -1) | 2484 | cperl-indent-parens-as-block)) |
| 2460 | (skip-chars-backward " \t") | 2485 | ;; group is an expression, not a block: |
| 2461 | (looking-at "[ \t]*[a-zA-Z_][a-zA-Z_0-9]*[ \t]*:")))) | 2486 | ;; indent to just after the surrounding open parens, |
| 2462 | (progn | 2487 | ;; skip blanks if we do not close the expression. |
| 2463 | (if (and parse-data | 2488 | (goto-char (1+ containing-sexp)) |
| 2464 | (not (eq char-after ?\C-j))) | 2489 | (or (memq char-after |
| 2465 | (setcdr (cddr parse-data) | 2490 | (append (if delim "}" ")]}") nil)) |
| 2466 | (list pre-indent-point))) | 2491 | (looking-at "[ \t]*\\(#\\|$\\)") |
| 2467 | 0) | 2492 | (skip-chars-forward " \t")) |
| 2468 | cperl-continued-statement-offset)))) | 2493 | (+ (current-column) |
| 2469 | ((not | 2494 | (if (and delim |
| 2470 | (or (setq is-block | 2495 | (eq char-after ?\})) |
| 2471 | (and (setq delim (= (char-after containing-sexp) ?{)) | 2496 | ;; Correct indentation of trailing ?\} |
| 2472 | (save-excursion ; Is it a hash? | 2497 | (+ cperl-indent-level cperl-close-paren-offset) |
| 2473 | (goto-char containing-sexp) | 2498 | 0))) |
| 2474 | (cperl-block-p)))) | ||
| 2475 | cperl-indent-parens-as-block)) | ||
| 2476 | ;; group is an expression, not a block: | ||
| 2477 | ;; indent to just after the surrounding open parens, | ||
| 2478 | ;; skip blanks if we do not close the expression. | ||
| 2479 | (goto-char (1+ containing-sexp)) | ||
| 2480 | (or (memq char-after (append ")]}" nil)) | ||
| 2481 | (looking-at "[ \t]*\\(#\\|$\\)") | ||
| 2482 | (skip-chars-forward " \t")) | ||
| 2483 | (current-column)) | ||
| 2484 | ((progn | ||
| 2485 | ;; Containing-expr starts with \{. Check whether it is a hash. | ||
| 2486 | (goto-char containing-sexp) | ||
| 2487 | (not (cperl-block-p))) | ||
| 2488 | (goto-char (1+ containing-sexp)) | ||
| 2489 | (or (memq char-after | ||
| 2490 | (append (if delim "}" ")]}") nil)) | ||
| 2491 | (looking-at "[ \t]*\\(#\\|$\\)") | ||
| 2492 | (skip-chars-forward " \t")) | ||
| 2493 | (+ (current-column) | ||
| 2494 | (if (and delim | ||
| 2495 | (eq char-after ?\})) | ||
| 2496 | ;; Correct indentation of trailing ?\} | ||
| 2497 | (+ cperl-indent-level cperl-close-paren-offset) | ||
| 2498 | 0))) | ||
| 2499 | ;;; ((and (/= (char-after containing-sexp) ?{) | 2499 | ;;; ((and (/= (char-after containing-sexp) ?{) |
| 2500 | ;;; (not cperl-indent-parens-as-block)) | 2500 | ;;; (not cperl-indent-parens-as-block)) |
| 2501 | ;;; ;; line is expression, not statement: | 2501 | ;;; ;; line is expression, not statement: |
| @@ -2519,151 +2519,151 @@ and closing parentheses and brackets." | |||
| 2519 | ;;; (if (eq char-after ?\}) (+ cperl-indent-level | 2519 | ;;; (if (eq char-after ?\}) (+ cperl-indent-level |
| 2520 | ;;; cperl-close-paren-offset) | 2520 | ;;; cperl-close-paren-offset) |
| 2521 | ;;; 0))) | 2521 | ;;; 0))) |
| 2522 | (t | 2522 | (t |
| 2523 | ;; Statement level. Is it a continuation or a new statement? | 2523 | ;; Statement level. Is it a continuation or a new statement? |
| 2524 | ;; Find previous non-comment character. | 2524 | ;; Find previous non-comment character. |
| 2525 | (goto-char pre-indent-point) | 2525 | (goto-char pre-indent-point) |
| 2526 | (cperl-backward-to-noncomment containing-sexp) | 2526 | (cperl-backward-to-noncomment containing-sexp) |
| 2527 | ;; Back up over label lines, since they don't | 2527 | ;; Back up over label lines, since they don't |
| 2528 | ;; affect whether our line is a continuation. | 2528 | ;; affect whether our line is a continuation. |
| 2529 | ;; (Had \, too) | 2529 | ;; (Had \, too) |
| 2530 | (while ;;(or (eq (preceding-char) ?\,) | 2530 | (while ;;(or (eq (preceding-char) ?\,) |
| 2531 | (and (eq (preceding-char) ?:) | 2531 | (and (eq (preceding-char) ?:) |
| 2532 | (or;;(eq (char-after (- (point) 2)) ?\') ; ???? | 2532 | (or ;;(eq (char-after (- (point) 2)) ?\') ; ???? |
| 2533 | (memq (char-syntax (char-after (- (point) 2))) | 2533 | (memq (char-syntax (char-after (- (point) 2))) |
| 2534 | '(?w ?_)))) | 2534 | '(?w ?_)))) |
| 2535 | ;;) | 2535 | ;;) |
| 2536 | (if (eq (preceding-char) ?\,) | 2536 | (if (eq (preceding-char) ?\,) |
| 2537 | ;; Will go to beginning of line, essentially. | 2537 | ;; Will go to beginning of line, essentially. |
| 2538 | ;; Will ignore embedded sexpr XXXX. | 2538 | ;; Will ignore embedded sexpr XXXX. |
| 2539 | (cperl-backward-to-start-of-continued-exp containing-sexp)) | 2539 | (cperl-backward-to-start-of-continued-exp containing-sexp)) |
| 2540 | (beginning-of-line) | 2540 | (beginning-of-line) |
| 2541 | (cperl-backward-to-noncomment containing-sexp)) | 2541 | (cperl-backward-to-noncomment containing-sexp)) |
| 2542 | ;; Now we get the answer. | 2542 | ;; Now we get the answer. |
| 2543 | (if (not (or (eq (1- (point)) containing-sexp) | 2543 | (if (not (or (eq (1- (point)) containing-sexp) |
| 2544 | (memq (preceding-char) | 2544 | (memq (preceding-char) |
| 2545 | (append (if is-block " ;{" " ,;{") '(nil))) | 2545 | (append (if is-block " ;{" " ,;{") '(nil))) |
| 2546 | (and (eq (preceding-char) ?\}) | 2546 | (and (eq (preceding-char) ?\}) |
| 2547 | (cperl-after-block-and-statement-beg | 2547 | (cperl-after-block-and-statement-beg |
| 2548 | containing-sexp)))) | 2548 | containing-sexp)))) |
| 2549 | ;; This line is continuation of preceding line's statement; | 2549 | ;; This line is continuation of preceding line's statement; |
| 2550 | ;; indent `cperl-continued-statement-offset' more than the | 2550 | ;; indent `cperl-continued-statement-offset' more than the |
| 2551 | ;; previous line of the statement. | 2551 | ;; previous line of the statement. |
| 2552 | ;; | 2552 | ;; |
| 2553 | ;; There might be a label on this line, just | 2553 | ;; There might be a label on this line, just |
| 2554 | ;; consider it bad style and ignore it. | 2554 | ;; consider it bad style and ignore it. |
| 2555 | (progn | ||
| 2556 | (cperl-backward-to-start-of-continued-exp containing-sexp) | ||
| 2557 | (+ (if (memq char-after (append "}])" nil)) | ||
| 2558 | 0 ; Closing parenth | ||
| 2559 | cperl-continued-statement-offset) | ||
| 2560 | (if (or is-block | ||
| 2561 | (not delim) | ||
| 2562 | (not (eq char-after ?\}))) | ||
| 2563 | 0 | ||
| 2564 | ;; Now it is a hash reference | ||
| 2565 | (+ cperl-indent-level cperl-close-paren-offset)) | ||
| 2566 | (if (looking-at "\\w+[ \t]*:") | ||
| 2567 | (if (> (current-indentation) cperl-min-label-indent) | ||
| 2568 | (- (current-indentation) cperl-label-offset) | ||
| 2569 | ;; Do not move `parse-data', this should | ||
| 2570 | ;; be quick anyway (this comment comes | ||
| 2571 | ;; from different location): | ||
| 2572 | (cperl-calculate-indent)) | ||
| 2573 | (current-column)) | ||
| 2574 | (if (eq char-after ?\{) | ||
| 2575 | cperl-continued-brace-offset 0))) | ||
| 2576 | ;; This line starts a new statement. | ||
| 2577 | ;; Position following last unclosed open. | ||
| 2578 | (goto-char containing-sexp) | ||
| 2579 | ;; Is line first statement after an open-brace? | ||
| 2580 | (or | ||
| 2581 | ;; If no, find that first statement and indent like | ||
| 2582 | ;; it. If the first statement begins with label, do | ||
| 2583 | ;; not believe when the indentation of the label is too | ||
| 2584 | ;; small. | ||
| 2585 | (save-excursion | ||
| 2586 | (forward-char 1) | ||
| 2587 | (setq old-indent (current-indentation)) | ||
| 2588 | (let ((colon-line-end 0)) | ||
| 2589 | (while (progn (skip-chars-forward " \t\n") | ||
| 2590 | (looking-at "#\\|[a-zA-Z0-9_$]*:[^:]")) | ||
| 2591 | ;; Skip over comments and labels following openbrace. | ||
| 2592 | (cond ((= (following-char) ?\#) | ||
| 2593 | (forward-line 1)) | ||
| 2594 | ;; label: | ||
| 2595 | (t | ||
| 2596 | (save-excursion (end-of-line) | ||
| 2597 | (setq colon-line-end (point))) | ||
| 2598 | (search-forward ":")))) | ||
| 2599 | ;; The first following code counts | ||
| 2600 | ;; if it is before the line we want to indent. | ||
| 2601 | (and (< (point) indent-point) | ||
| 2602 | (if (> colon-line-end (point)) ; After label | ||
| 2603 | (if (> (current-indentation) | ||
| 2604 | cperl-min-label-indent) | ||
| 2605 | (- (current-indentation) cperl-label-offset) | ||
| 2606 | ;; Do not believe: `max' is involved | ||
| 2607 | (+ old-indent cperl-indent-level)) | ||
| 2608 | (current-column))))) | ||
| 2609 | ;; If no previous statement, | ||
| 2610 | ;; indent it relative to line brace is on. | ||
| 2611 | ;; For open brace in column zero, don't let statement | ||
| 2612 | ;; start there too. If cperl-indent-level is zero, | ||
| 2613 | ;; use cperl-brace-offset + cperl-continued-statement-offset instead. | ||
| 2614 | ;; For open-braces not the first thing in a line, | ||
| 2615 | ;; add in cperl-brace-imaginary-offset. | ||
| 2616 | |||
| 2617 | ;; If first thing on a line: ????? | ||
| 2618 | (+ (if (and (bolp) (zerop cperl-indent-level)) | ||
| 2619 | (+ cperl-brace-offset cperl-continued-statement-offset) | ||
| 2620 | cperl-indent-level) | ||
| 2621 | (if (or is-block | ||
| 2622 | (not delim) | ||
| 2623 | (not (eq char-after ?\}))) | ||
| 2624 | 0 | ||
| 2625 | ;; Now it is a hash reference | ||
| 2626 | (+ cperl-indent-level cperl-close-paren-offset)) | ||
| 2627 | ;; Move back over whitespace before the openbrace. | ||
| 2628 | ;; If openbrace is not first nonwhite thing on the line, | ||
| 2629 | ;; add the cperl-brace-imaginary-offset. | ||
| 2630 | (progn (skip-chars-backward " \t") | ||
| 2631 | (if (bolp) 0 cperl-brace-imaginary-offset)) | ||
| 2632 | ;; If the openbrace is preceded by a parenthesized exp, | ||
| 2633 | ;; move to the beginning of that; | ||
| 2634 | ;; possibly a different line | ||
| 2635 | (progn | 2555 | (progn |
| 2636 | (if (eq (preceding-char) ?\)) | 2556 | (cperl-backward-to-start-of-continued-exp containing-sexp) |
| 2637 | (forward-sexp -1)) | 2557 | (+ (if (memq char-after (append "}])" nil)) |
| 2638 | ;; In the case it starts a subroutine, indent with | 2558 | 0 ; Closing parenth |
| 2639 | ;; respect to `sub', not with respect to the | 2559 | cperl-continued-statement-offset) |
| 2640 | ;; first thing on the line, say in the case of | 2560 | (if (or is-block |
| 2641 | ;; anonymous sub in a hash. | 2561 | (not delim) |
| 2642 | ;; | 2562 | (not (eq char-after ?\}))) |
| 2643 | (skip-chars-backward " \t") | 2563 | 0 |
| 2644 | (if (and (eq (preceding-char) ?b) | 2564 | ;; Now it is a hash reference |
| 2645 | (progn | 2565 | (+ cperl-indent-level cperl-close-paren-offset)) |
| 2646 | (forward-sexp -1) | 2566 | (if (looking-at "\\w+[ \t]*:") |
| 2647 | (looking-at "sub\\>")) | 2567 | (if (> (current-indentation) cperl-min-label-indent) |
| 2648 | (setq old-indent | 2568 | (- (current-indentation) cperl-label-offset) |
| 2649 | (nth 1 | 2569 | ;; Do not move `parse-data', this should |
| 2650 | (parse-partial-sexp | 2570 | ;; be quick anyway (this comment comes |
| 2651 | (save-excursion (beginning-of-line) (point)) | 2571 | ;; from different location): |
| 2652 | (point))))) | 2572 | (cperl-calculate-indent)) |
| 2653 | (progn (goto-char (1+ old-indent)) | 2573 | (current-column)) |
| 2654 | (skip-chars-forward " \t") | 2574 | (if (eq char-after ?\{) |
| 2655 | (current-column)) | 2575 | cperl-continued-brace-offset 0))) |
| 2656 | ;; Get initial indentation of the line we are on. | 2576 | ;; This line starts a new statement. |
| 2657 | ;; If line starts with label, calculate label indentation | 2577 | ;; Position following last unclosed open. |
| 2658 | (if (save-excursion | 2578 | (goto-char containing-sexp) |
| 2659 | (beginning-of-line) | 2579 | ;; Is line first statement after an open-brace? |
| 2660 | (looking-at "[ \t]*[a-zA-Z_][a-zA-Z_0-9]*:[^:]")) | 2580 | (or |
| 2661 | (if (> (current-indentation) cperl-min-label-indent) | 2581 | ;; If no, find that first statement and indent like |
| 2662 | (- (current-indentation) cperl-label-offset) | 2582 | ;; it. If the first statement begins with label, do |
| 2663 | ;; Do not move `parse-data', this should | 2583 | ;; not believe when the indentation of the label is too |
| 2664 | ;; be quick anyway: | 2584 | ;; small. |
| 2665 | (cperl-calculate-indent)) | 2585 | (save-excursion |
| 2666 | (current-indentation)))))))))))))) | 2586 | (forward-char 1) |
| 2587 | (setq old-indent (current-indentation)) | ||
| 2588 | (let ((colon-line-end 0)) | ||
| 2589 | (while (progn (skip-chars-forward " \t\n") | ||
| 2590 | (looking-at "#\\|[a-zA-Z0-9_$]*:[^:]")) | ||
| 2591 | ;; Skip over comments and labels following openbrace. | ||
| 2592 | (cond ((= (following-char) ?\#) | ||
| 2593 | (forward-line 1)) | ||
| 2594 | ;; label: | ||
| 2595 | (t | ||
| 2596 | (save-excursion (end-of-line) | ||
| 2597 | (setq colon-line-end (point))) | ||
| 2598 | (search-forward ":")))) | ||
| 2599 | ;; The first following code counts | ||
| 2600 | ;; if it is before the line we want to indent. | ||
| 2601 | (and (< (point) indent-point) | ||
| 2602 | (if (> colon-line-end (point)) ; After label | ||
| 2603 | (if (> (current-indentation) | ||
| 2604 | cperl-min-label-indent) | ||
| 2605 | (- (current-indentation) cperl-label-offset) | ||
| 2606 | ;; Do not believe: `max' is involved | ||
| 2607 | (+ old-indent cperl-indent-level)) | ||
| 2608 | (current-column))))) | ||
| 2609 | ;; If no previous statement, | ||
| 2610 | ;; indent it relative to line brace is on. | ||
| 2611 | ;; For open brace in column zero, don't let statement | ||
| 2612 | ;; start there too. If cperl-indent-level is zero, | ||
| 2613 | ;; use cperl-brace-offset + cperl-continued-statement-offset instead. | ||
| 2614 | ;; For open-braces not the first thing in a line, | ||
| 2615 | ;; add in cperl-brace-imaginary-offset. | ||
| 2616 | |||
| 2617 | ;; If first thing on a line: ????? | ||
| 2618 | (+ (if (and (bolp) (zerop cperl-indent-level)) | ||
| 2619 | (+ cperl-brace-offset cperl-continued-statement-offset) | ||
| 2620 | cperl-indent-level) | ||
| 2621 | (if (or is-block | ||
| 2622 | (not delim) | ||
| 2623 | (not (eq char-after ?\}))) | ||
| 2624 | 0 | ||
| 2625 | ;; Now it is a hash reference | ||
| 2626 | (+ cperl-indent-level cperl-close-paren-offset)) | ||
| 2627 | ;; Move back over whitespace before the openbrace. | ||
| 2628 | ;; If openbrace is not first nonwhite thing on the line, | ||
| 2629 | ;; add the cperl-brace-imaginary-offset. | ||
| 2630 | (progn (skip-chars-backward " \t") | ||
| 2631 | (if (bolp) 0 cperl-brace-imaginary-offset)) | ||
| 2632 | ;; If the openbrace is preceded by a parenthesized exp, | ||
| 2633 | ;; move to the beginning of that; | ||
| 2634 | ;; possibly a different line | ||
| 2635 | (progn | ||
| 2636 | (if (eq (preceding-char) ?\)) | ||
| 2637 | (forward-sexp -1)) | ||
| 2638 | ;; In the case it starts a subroutine, indent with | ||
| 2639 | ;; respect to `sub', not with respect to the | ||
| 2640 | ;; first thing on the line, say in the case of | ||
| 2641 | ;; anonymous sub in a hash. | ||
| 2642 | ;; | ||
| 2643 | (skip-chars-backward " \t") | ||
| 2644 | (if (and (eq (preceding-char) ?b) | ||
| 2645 | (progn | ||
| 2646 | (forward-sexp -1) | ||
| 2647 | (looking-at "sub\\>")) | ||
| 2648 | (setq old-indent | ||
| 2649 | (nth 1 | ||
| 2650 | (parse-partial-sexp | ||
| 2651 | (save-excursion (beginning-of-line) (point)) | ||
| 2652 | (point))))) | ||
| 2653 | (progn (goto-char (1+ old-indent)) | ||
| 2654 | (skip-chars-forward " \t") | ||
| 2655 | (current-column)) | ||
| 2656 | ;; Get initial indentation of the line we are on. | ||
| 2657 | ;; If line starts with label, calculate label indentation | ||
| 2658 | (if (save-excursion | ||
| 2659 | (beginning-of-line) | ||
| 2660 | (looking-at "[ \t]*[a-zA-Z_][a-zA-Z_0-9]*:[^:]")) | ||
| 2661 | (if (> (current-indentation) cperl-min-label-indent) | ||
| 2662 | (- (current-indentation) cperl-label-offset) | ||
| 2663 | ;; Do not move `parse-data', this should | ||
| 2664 | ;; be quick anyway: | ||
| 2665 | (cperl-calculate-indent)) | ||
| 2666 | (current-indentation)))))))))))))) | ||
| 2667 | 2667 | ||
| 2668 | (defvar cperl-indent-alist | 2668 | (defvar cperl-indent-alist |
| 2669 | '((string nil) | 2669 | '((string nil) |
| @@ -2725,9 +2725,9 @@ Not finished, not used." | |||
| 2725 | (point))) | 2725 | (point))) |
| 2726 | (cons (list 'expression containing-sexp) res)))) | 2726 | (cons (list 'expression containing-sexp) res)))) |
| 2727 | ((progn | 2727 | ((progn |
| 2728 | ;; Containing-expr starts with \{. Check whether it is a hash. | 2728 | ;; Containing-expr starts with \{. Check whether it is a hash. |
| 2729 | (goto-char containing-sexp) | 2729 | (goto-char containing-sexp) |
| 2730 | (not (cperl-block-p))) | 2730 | (not (cperl-block-p))) |
| 2731 | (setq res (cons (list 'expression-blanks | 2731 | (setq res (cons (list 'expression-blanks |
| 2732 | (progn | 2732 | (progn |
| 2733 | (goto-char (1+ containing-sexp)) | 2733 | (goto-char (1+ containing-sexp)) |
| @@ -2748,7 +2748,7 @@ Not finished, not used." | |||
| 2748 | (save-excursion (cperl-after-label))) | 2748 | (save-excursion (cperl-after-label))) |
| 2749 | (if (eq (preceding-char) ?\,) | 2749 | (if (eq (preceding-char) ?\,) |
| 2750 | ;; Will go to beginning of line, essentially | 2750 | ;; Will go to beginning of line, essentially |
| 2751 | ;; Will ignore embedded sexpr XXXX. | 2751 | ;; Will ignore embedded sexpr XXXX. |
| 2752 | (cperl-backward-to-start-of-continued-exp containing-sexp)) | 2752 | (cperl-backward-to-start-of-continued-exp containing-sexp)) |
| 2753 | (beginning-of-line) | 2753 | (beginning-of-line) |
| 2754 | (cperl-backward-to-noncomment containing-sexp)) | 2754 | (cperl-backward-to-noncomment containing-sexp)) |
| @@ -2848,43 +2848,42 @@ the current line is to be regarded as part of a block comment." | |||
| 2848 | "Go to position before comment on the current line, or to end of line. | 2848 | "Go to position before comment on the current line, or to end of line. |
| 2849 | Returns true if comment is found." | 2849 | Returns true if comment is found." |
| 2850 | (let (state stop-in cpoint (lim (progn (end-of-line) (point)))) | 2850 | (let (state stop-in cpoint (lim (progn (end-of-line) (point)))) |
| 2851 | (beginning-of-line) | 2851 | (beginning-of-line) |
| 2852 | (if (or | 2852 | (if (or |
| 2853 | (eq (get-text-property (point) 'syntax-type) 'pod) | 2853 | (eq (get-text-property (point) 'syntax-type) 'pod) |
| 2854 | (re-search-forward "\\=[ \t]*\\(#\\|$\\)" lim t)) | 2854 | (re-search-forward "\\=[ \t]*\\(#\\|$\\)" lim t)) |
| 2855 | (if (eq (preceding-char) ?\#) (progn (backward-char 1) t)) | 2855 | (if (eq (preceding-char) ?\#) (progn (backward-char 1) t)) |
| 2856 | ;; Else | 2856 | ;; Else |
| 2857 | (while (not stop-in) | 2857 | (while (not stop-in) |
| 2858 | (setq state (parse-partial-sexp (point) lim nil nil nil t)) | 2858 | (setq state (parse-partial-sexp (point) lim nil nil nil t)) |
| 2859 | ; stop at comment | 2859 | ; stop at comment |
| 2860 | ;; If fails (beginning-of-line inside sexp), then contains not-comment | 2860 | ;; If fails (beginning-of-line inside sexp), then contains not-comment |
| 2861 | (if (nth 4 state) ; After `#'; | 2861 | (if (nth 4 state) ; After `#'; |
| 2862 | ; (nth 2 state) can be | 2862 | ; (nth 2 state) can be |
| 2863 | ; beginning of m,s,qq and so | 2863 | ; beginning of m,s,qq and so |
| 2864 | ; on | 2864 | ; on |
| 2865 | (if (nth 2 state) | 2865 | (if (nth 2 state) |
| 2866 | (progn | 2866 | (progn |
| 2867 | (setq cpoint (point)) | 2867 | (setq cpoint (point)) |
| 2868 | (goto-char (nth 2 state)) | 2868 | (goto-char (nth 2 state)) |
| 2869 | (cond | 2869 | (cond |
| 2870 | ((looking-at "\\(s\\|tr\\)\\>") | 2870 | ((looking-at "\\(s\\|tr\\)\\>") |
| 2871 | (or (re-search-forward | 2871 | (or (re-search-forward |
| 2872 | "\\=\\w+[ \t]*#\\([^\n\\\\#]\\|\\\\[\\\\#]\\)*#\\([^\n\\\\#]\\|\\\\[\\\\#]\\)*" | 2872 | "\\=\\w+[ \t]*#\\([^\n\\\\#]\\|\\\\[\\\\#]\\)*#\\([^\n\\\\#]\\|\\\\[\\\\#]\\)*" |
| 2873 | lim 'move) | 2873 | lim 'move) |
| 2874 | (setq stop-in t))) | 2874 | (setq stop-in t))) |
| 2875 | ((looking-at "\\(m\\|q\\([qxwr]\\)?\\)\\>") | 2875 | ((looking-at "\\(m\\|q\\([qxwr]\\)?\\)\\>") |
| 2876 | (or (re-search-forward | 2876 | (or (re-search-forward |
| 2877 | "\\=\\w+[ \t]*#\\([^\n\\\\#]\\|\\\\[\\\\#]\\)*#" | 2877 | "\\=\\w+[ \t]*#\\([^\n\\\\#]\\|\\\\[\\\\#]\\)*#" |
| 2878 | lim 'move) | 2878 | lim 'move) |
| 2879 | (setq stop-in t))) | 2879 | (setq stop-in t))) |
| 2880 | (t ; It was fair comment | 2880 | (t ; It was fair comment |
| 2881 | (setq stop-in t) ; Finish | 2881 | (setq stop-in t) ; Finish |
| 2882 | (goto-char (1- cpoint))))) | 2882 | (goto-char (1- cpoint))))) |
| 2883 | (setq stop-in t) ; Finish | 2883 | (setq stop-in t) ; Finish |
| 2884 | (forward-char -1)) | 2884 | (forward-char -1)) |
| 2885 | (setq stop-in t)) ; Finish | 2885 | (setq stop-in t))) ; Finish |
| 2886 | ) | 2886 | (nth 4 state)))) |
| 2887 | (nth 4 state)))) | ||
| 2888 | 2887 | ||
| 2889 | (defsubst cperl-1- (p) | 2888 | (defsubst cperl-1- (p) |
| 2890 | (max (point-min) (1- p))) | 2889 | (max (point-min) (1- p))) |
| @@ -3031,11 +3030,14 @@ Returns true if comment is found." | |||
| 3031 | ;; go-forward: has 2 args, and the second part is empty | 3030 | ;; go-forward: has 2 args, and the second part is empty |
| 3032 | (list i i2 ender starter go-forward))) | 3031 | (list i i2 ender starter go-forward))) |
| 3033 | 3032 | ||
| 3033 | (defvar font-lock-string-face) | ||
| 3034 | ;;(defvar font-lock-reference-face) | ||
| 3035 | (defvar font-lock-constant-face) | ||
| 3034 | (defsubst cperl-postpone-fontification (b e type val &optional now) | 3036 | (defsubst cperl-postpone-fontification (b e type val &optional now) |
| 3035 | ;; Do after syntactic fontification? | 3037 | ;; Do after syntactic fontification? |
| 3036 | (if cperl-syntaxify-by-font-lock | 3038 | (if cperl-syntaxify-by-font-lock |
| 3037 | (or now (put-text-property b e 'cperl-postpone (cons type val))) | 3039 | (or now (put-text-property b e 'cperl-postpone (cons type val))) |
| 3038 | (put-text-property b e type val))) | 3040 | (put-text-property b e type val))) |
| 3039 | 3041 | ||
| 3040 | ;;; Here is how the global structures (those which cannot be | 3042 | ;;; Here is how the global structures (those which cannot be |
| 3041 | ;;; recognized locally) are marked: | 3043 | ;;; recognized locally) are marked: |
| @@ -3095,100 +3097,99 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', | |||
| 3095 | cperl-syntax-state nil | 3097 | cperl-syntax-state nil |
| 3096 | cperl-syntax-done-to min)) | 3098 | cperl-syntax-done-to min)) |
| 3097 | (or max (setq max (point-max))) | 3099 | (or max (setq max (point-max))) |
| 3098 | (let* (face head-face here-face b e bb tag qtag b1 e1 argument i c tail tb | 3100 | (let* ((cperl-pod-here-fontify (eval cperl-pod-here-fontify)) go tmpend |
| 3099 | is-REx is-x-REx REx-comment-start REx-comment-end was-comment i2 | 3101 | face head-face here-face b e bb tag qtag b1 e1 argument i c tail tb |
| 3100 | (cperl-pod-here-fontify (eval cperl-pod-here-fontify)) go tmpend | 3102 | is-REx is-x-REx REx-comment-start REx-comment-end was-comment i2 |
| 3101 | (case-fold-search nil) (inhibit-read-only t) (buffer-undo-list t) | 3103 | (case-fold-search nil) (inhibit-read-only t) (buffer-undo-list t) |
| 3102 | (modified (buffer-modified-p)) | 3104 | (modified (buffer-modified-p)) |
| 3103 | (after-change-functions nil) | 3105 | (after-change-functions nil) |
| 3104 | (use-syntax-state (and cperl-syntax-state | 3106 | (use-syntax-state (and cperl-syntax-state |
| 3105 | (>= min (car cperl-syntax-state)))) | 3107 | (>= min (car cperl-syntax-state)))) |
| 3106 | (state-point (if use-syntax-state | 3108 | (state-point (if use-syntax-state |
| 3107 | (car cperl-syntax-state) | 3109 | (car cperl-syntax-state) |
| 3108 | (point-min))) | 3110 | (point-min))) |
| 3109 | (state (if use-syntax-state | 3111 | (state (if use-syntax-state |
| 3110 | (cdr cperl-syntax-state))) | 3112 | (cdr cperl-syntax-state))) |
| 3111 | ;; (st-l '(nil)) (err-l '(nil)) ; Would overwrite - propagates from a function call to a function call! | 3113 | ;; (st-l '(nil)) (err-l '(nil)) ; Would overwrite - propagates from a function call to a function call! |
| 3112 | (st-l (list nil)) (err-l (list nil)) | 3114 | (st-l (list nil)) (err-l (list nil)) |
| 3113 | ;; Somehow font-lock may be not loaded yet... | 3115 | ;; Somehow font-lock may be not loaded yet... |
| 3114 | (font-lock-string-face (if (boundp 'font-lock-string-face) | 3116 | (font-lock-string-face (if (boundp 'font-lock-string-face) |
| 3115 | font-lock-string-face | 3117 | font-lock-string-face |
| 3116 | 'font-lock-string-face)) | 3118 | 'font-lock-string-face)) |
| 3117 | (font-lock-constant-face (if (boundp 'font-lock-constant-face) | 3119 | (font-lock-constant-face (if (boundp 'font-lock-constant-face) |
| 3118 | font-lock-constant-face | 3120 | font-lock-constant-face |
| 3119 | 'font-lock-constant-face)) | 3121 | 'font-lock-constant-face)) |
| 3120 | (font-lock-function-name-face | 3122 | (font-lock-function-name-face |
| 3121 | (if (boundp 'font-lock-function-name-face) | 3123 | (if (boundp 'font-lock-function-name-face) |
| 3122 | font-lock-function-name-face | 3124 | font-lock-function-name-face |
| 3123 | 'font-lock-function-name-face)) | 3125 | 'font-lock-function-name-face)) |
| 3124 | (font-lock-comment-face | 3126 | (font-lock-comment-face |
| 3125 | (if (boundp 'font-lock-comment-face) | 3127 | (if (boundp 'font-lock-comment-face) |
| 3126 | font-lock-comment-face | 3128 | font-lock-comment-face |
| 3127 | 'font-lock-comment-face)) | 3129 | 'font-lock-comment-face)) |
| 3128 | (cperl-nonoverridable-face | 3130 | (cperl-nonoverridable-face |
| 3129 | (if (boundp 'cperl-nonoverridable-face) | 3131 | (if (boundp 'cperl-nonoverridable-face) |
| 3130 | cperl-nonoverridable-face | 3132 | cperl-nonoverridable-face |
| 3131 | 'cperl-nonoverridable-face)) | 3133 | 'cperl-nonoverridable-face)) |
| 3132 | (stop-point (if ignore-max | 3134 | (stop-point (if ignore-max |
| 3133 | (point-max) | 3135 | (point-max) |
| 3134 | max)) | 3136 | max)) |
| 3135 | (search | 3137 | (search |
| 3138 | (concat | ||
| 3139 | "\\(\\`\n?\\|^\n\\)=" | ||
| 3140 | "\\|" | ||
| 3141 | ;; One extra () before this: | ||
| 3142 | "<<" | ||
| 3143 | "\\(" ; 1 + 1 | ||
| 3144 | ;; First variant "BLAH" or just ``. | ||
| 3145 | "[ \t]*" ; Yes, whitespace is allowed! | ||
| 3146 | "\\([\"'`]\\)" ; 2 + 1 = 3 | ||
| 3147 | "\\([^\"'`\n]*\\)" ; 3 + 1 | ||
| 3148 | "\\3" | ||
| 3149 | "\\|" | ||
| 3150 | ;; Second variant: Identifier or \ID or empty | ||
| 3151 | "\\\\?\\(\\([a-zA-Z_][a-zA-Z_0-9]*\\)?\\)" ; 4 + 1, 5 + 1 | ||
| 3152 | ;; Do not have <<= or << 30 or <<30 or << $blah. | ||
| 3153 | ;; "\\([^= \t0-9$@%&]\\|[ \t]+[^ \t\n0-9$@%&]\\)" ; 6 + 1 | ||
| 3154 | "\\(\\)" ; To preserve count of pars :-( 6 + 1 | ||
| 3155 | "\\)" | ||
| 3156 | "\\|" | ||
| 3157 | ;; 1+6 extra () before this: | ||
| 3158 | "^[ \t]*\\(format\\)[ \t]*\\([a-zA-Z0-9_]+\\)?[ \t]*=[ \t]*$" | ||
| 3159 | (if cperl-use-syntax-table-text-property | ||
| 3136 | (concat | 3160 | (concat |
| 3137 | "\\(\\`\n?\\|^\n\\)=" | ||
| 3138 | "\\|" | 3161 | "\\|" |
| 3139 | ;; One extra () before this: | 3162 | ;; 1+6+2=9 extra () before this: |
| 3140 | "<<" | 3163 | "\\<\\(q[wxqr]?\\|[msy]\\|tr\\)\\>" |
| 3141 | "\\(" ; 1 + 1 | 3164 | "\\|" |
| 3142 | ;; First variant "BLAH" or just ``. | 3165 | ;; 1+6+2+1=10 extra () before this: |
| 3143 | "[ \t]*" ; Yes, whitespace is allowed! | 3166 | "\\([?/<]\\)" ; /blah/ or ?blah? or <file*glob> |
| 3144 | "\\([\"'`]\\)" ; 2 + 1 = 3 | 3167 | "\\|" |
| 3145 | "\\([^\"'`\n]*\\)" ; 3 + 1 | 3168 | ;; 1+6+2+1+1=11 extra () before this: |
| 3146 | "\\3" | 3169 | "\\<sub\\>[ \t]*\\([a-zA-Z_:'0-9]+[ \t]*\\)?\\(([^()]*)\\)" |
| 3147 | "\\|" | 3170 | "\\|" |
| 3148 | ;; Second variant: Identifier or \ID or empty | 3171 | ;; 1+6+2+1+1+2=13 extra () before this: |
| 3149 | "\\\\?\\(\\([a-zA-Z_][a-zA-Z_0-9]*\\)?\\)" ; 4 + 1, 5 + 1 | 3172 | "\\$\\(['{]\\)" |
| 3150 | ;; Do not have <<= or << 30 or <<30 or << $blah. | 3173 | "\\|" |
| 3151 | ;; "\\([^= \t0-9$@%&]\\|[ \t]+[^ \t\n0-9$@%&]\\)" ; 6 + 1 | 3174 | ;; 1+6+2+1+1+2+1=14 extra () before this: |
| 3152 | "\\(\\)" ; To preserve count of pars :-( 6 + 1 | 3175 | "\\(\\<sub[ \t\n\f]+\\|[&*$@%]\\)[a-zA-Z0-9_]*'" |
| 3153 | "\\)" | 3176 | ;; 1+6+2+1+1+2+1+1=15 extra () before this: |
| 3177 | "\\|" | ||
| 3178 | "__\\(END\\|DATA\\)__" | ||
| 3179 | ;; 1+6+2+1+1+2+1+1+1=16 extra () before this: | ||
| 3154 | "\\|" | 3180 | "\\|" |
| 3155 | ;; 1+6 extra () before this: | 3181 | "\\\\\\(['`\"]\\)") |
| 3156 | "^[ \t]*\\(format\\)[ \t]*\\([a-zA-Z0-9_]+\\)?[ \t]*=[ \t]*$" | 3182 | "")))) |
| 3157 | (if cperl-use-syntax-table-text-property | ||
| 3158 | (concat | ||
| 3159 | "\\|" | ||
| 3160 | ;; 1+6+2=9 extra () before this: | ||
| 3161 | "\\<\\(q[wxqr]?\\|[msy]\\|tr\\)\\>" | ||
| 3162 | "\\|" | ||
| 3163 | ;; 1+6+2+1=10 extra () before this: | ||
| 3164 | "\\([?/<]\\)" ; /blah/ or ?blah? or <file*glob> | ||
| 3165 | "\\|" | ||
| 3166 | ;; 1+6+2+1+1=11 extra () before this: | ||
| 3167 | "\\<sub\\>[ \t]*\\([a-zA-Z_:'0-9]+[ \t]*\\)?\\(([^()]*)\\)" | ||
| 3168 | "\\|" | ||
| 3169 | ;; 1+6+2+1+1+2=13 extra () before this: | ||
| 3170 | "\\$\\(['{]\\)" | ||
| 3171 | "\\|" | ||
| 3172 | ;; 1+6+2+1+1+2+1=14 extra () before this: | ||
| 3173 | "\\(\\<sub[ \t\n\f]+\\|[&*$@%]\\)[a-zA-Z0-9_]*'" | ||
| 3174 | ;; 1+6+2+1+1+2+1+1=15 extra () before this: | ||
| 3175 | "\\|" | ||
| 3176 | "__\\(END\\|DATA\\)__" | ||
| 3177 | ;; 1+6+2+1+1+2+1+1+1=16 extra () before this: | ||
| 3178 | "\\|" | ||
| 3179 | "\\\\\\(['`\"]\\)" | ||
| 3180 | ) | ||
| 3181 | "")))) | ||
| 3182 | (unwind-protect | 3183 | (unwind-protect |
| 3183 | (progn | 3184 | (progn |
| 3184 | (save-excursion | 3185 | (save-excursion |
| 3185 | (or non-inter | 3186 | (or non-inter |
| 3186 | (message "Scanning for \"hard\" Perl constructions...")) | 3187 | (message "Scanning for \"hard\" Perl constructions...")) |
| 3187 | (and cperl-pod-here-fontify | 3188 | (and cperl-pod-here-fontify |
| 3188 | ;; We had evals here, do not know why... | 3189 | ;; We had evals here, do not know why... |
| 3189 | (setq face cperl-pod-face | 3190 | (setq face cperl-pod-face |
| 3190 | head-face cperl-pod-head-face | 3191 | head-face cperl-pod-head-face |
| 3191 | here-face cperl-here-face)) | 3192 | here-face cperl-here-face)) |
| 3192 | (remove-text-properties min max | 3193 | (remove-text-properties min max |
| 3193 | '(syntax-type t in-pod t syntax-table t | 3194 | '(syntax-type t in-pod t syntax-table t |
| 3194 | cperl-postpone t | 3195 | cperl-postpone t |
| @@ -3279,7 +3280,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', | |||
| 3279 | (cperl-commentify bb e nil) | 3280 | (cperl-commentify bb e nil) |
| 3280 | (goto-char e) | 3281 | (goto-char e) |
| 3281 | (or (eq e (point-max)) | 3282 | (or (eq e (point-max)) |
| 3282 | (forward-char -1)))) ; Prepare for immediate pod start. | 3283 | (forward-char -1)))) ; Prepare for immediate POD start. |
| 3283 | ;; Here document | 3284 | ;; Here document |
| 3284 | ;; We do only one here-per-line | 3285 | ;; We do only one here-per-line |
| 3285 | ;; ;; One extra () before this: | 3286 | ;; ;; One extra () before this: |
| @@ -3333,11 +3334,11 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', | |||
| 3333 | (progn | 3334 | (progn |
| 3334 | ;; Highlight the ending delimiter | 3335 | ;; Highlight the ending delimiter |
| 3335 | (cperl-postpone-fontification (match-beginning 0) (match-end 0) | 3336 | (cperl-postpone-fontification (match-beginning 0) (match-end 0) |
| 3336 | 'face font-lock-constant-face) | 3337 | 'face font-lock-constant-face) |
| 3337 | (cperl-put-do-not-fontify b (match-end 0) t) | 3338 | (cperl-put-do-not-fontify b (match-end 0) t) |
| 3338 | ;; Highlight the HERE-DOC | 3339 | ;; Highlight the HERE-DOC |
| 3339 | (cperl-postpone-fontification b (match-beginning 0) | 3340 | (cperl-postpone-fontification b (match-beginning 0) |
| 3340 | 'face here-face))) | 3341 | 'face here-face))) |
| 3341 | (setq e1 (cperl-1+ (match-end 0))) | 3342 | (setq e1 (cperl-1+ (match-end 0))) |
| 3342 | (put-text-property b (match-beginning 0) | 3343 | (put-text-property b (match-beginning 0) |
| 3343 | 'syntax-type 'here-doc) | 3344 | 'syntax-type 'here-doc) |
| @@ -3379,18 +3380,18 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', | |||
| 3379 | (end-of-line) | 3380 | (end-of-line) |
| 3380 | ;; Highlight the format line | 3381 | ;; Highlight the format line |
| 3381 | (cperl-postpone-fontification b1 (point) | 3382 | (cperl-postpone-fontification b1 (point) |
| 3382 | 'face font-lock-string-face) | 3383 | 'face font-lock-string-face) |
| 3383 | (cperl-commentify b1 (point) nil) | 3384 | (cperl-commentify b1 (point) nil) |
| 3384 | (cperl-put-do-not-fontify b1 (point) t)))) | 3385 | (cperl-put-do-not-fontify b1 (point) t)))) |
| 3385 | ;; We do not search to max, since we may be called from | 3386 | ;; We do not search to max, since we may be called from |
| 3386 | ;; some hook of fontification, and max is random | 3387 | ;; some hook of fontification, and max is random |
| 3387 | (re-search-forward "^[.;]$" stop-point 'toend)) | 3388 | (re-search-forward "^[.;]$" stop-point 'toend)) |
| 3388 | (beginning-of-line) | 3389 | (beginning-of-line) |
| 3389 | (if (looking-at "^\\.$") ; ";" is not supported yet | 3390 | (if (looking-at "^\\.$") ; ";" is not supported yet |
| 3390 | (progn | 3391 | (progn |
| 3391 | ;; Highlight the ending delimiter | 3392 | ;; Highlight the ending delimiter |
| 3392 | (cperl-postpone-fontification (point) (+ (point) 2) | 3393 | (cperl-postpone-fontification (point) (+ (point) 2) |
| 3393 | 'face font-lock-string-face) | 3394 | 'face font-lock-string-face) |
| 3394 | (cperl-commentify (point) (+ (point) 2) nil) | 3395 | (cperl-commentify (point) (+ (point) 2) nil) |
| 3395 | (cperl-put-do-not-fontify (point) (+ (point) 2) t)) | 3396 | (cperl-put-do-not-fontify (point) (+ (point) 2) t)) |
| 3396 | (message "End of format `%s' not found." name) | 3397 | (message "End of format `%s' not found." name) |
| @@ -3418,7 +3419,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', | |||
| 3418 | (memq bb '(?\$ ?\@ ?\% ?\* ?\#)) ; $#y | 3419 | (memq bb '(?\$ ?\@ ?\% ?\* ?\#)) ; $#y |
| 3419 | (and (eq bb ?-) (eq c ?s)) ; -s file test | 3420 | (and (eq bb ?-) (eq c ?s)) ; -s file test |
| 3420 | (and (eq bb ?\&) | 3421 | (and (eq bb ?\&) |
| 3421 | (not (eq (char-after ; &&m/blah/ | 3422 | (not (eq (char-after ; &&m/blah/ |
| 3422 | (- (match-beginning b1) 2)) | 3423 | (- (match-beginning b1) 2)) |
| 3423 | ?\&)))) | 3424 | ?\&)))) |
| 3424 | ;; <file> or <$file> | 3425 | ;; <file> or <$file> |
| @@ -3599,10 +3600,10 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', | |||
| 3599 | (if is-x-REx | 3600 | (if is-x-REx |
| 3600 | (if (eq (char-after b) ?\#) | 3601 | (if (eq (char-after b) ?\#) |
| 3601 | "\\((\\?\\\\#\\)\\|\\(\\\\#\\)" | 3602 | "\\((\\?\\\\#\\)\\|\\(\\\\#\\)" |
| 3602 | "\\((\\?#\\)\\|\\(#\\)") | 3603 | "\\((\\?#\\)\\|\\(#\\)") |
| 3603 | (if (eq (char-after b) ?\#) | 3604 | (if (eq (char-after b) ?\#) |
| 3604 | "\\((\\?\\\\#\\)" | 3605 | "\\((\\?\\\\#\\)" |
| 3605 | "\\((\\?#\\)")) | 3606 | "\\((\\?#\\)")) |
| 3606 | (1- e) 'to-end)) | 3607 | (1- e) 'to-end)) |
| 3607 | (goto-char (match-beginning 0)) | 3608 | (goto-char (match-beginning 0)) |
| 3608 | (setq REx-comment-start (point) | 3609 | (setq REx-comment-start (point) |
| @@ -3744,13 +3745,12 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', | |||
| 3744 | (if (memq (setq pr (get-text-property (point) 'syntax-type)) | 3745 | (if (memq (setq pr (get-text-property (point) 'syntax-type)) |
| 3745 | '(pod here-doc here-doc-delim)) | 3746 | '(pod here-doc here-doc-delim)) |
| 3746 | (cperl-unwind-to-safe nil) | 3747 | (cperl-unwind-to-safe nil) |
| 3747 | (if (or (looking-at "^[ \t]*\\(#\\|$\\)") | 3748 | (or (looking-at "^[ \t]*\\(#\\|$\\)") |
| 3748 | (progn (cperl-to-comment-or-eol) (bolp))) | 3749 | (progn (cperl-to-comment-or-eol) (bolp)) |
| 3749 | nil ; Only comment, skip | 3750 | (progn |
| 3750 | ;; Else | 3751 | (skip-chars-backward " \t") |
| 3751 | (skip-chars-backward " \t") | 3752 | (if (< p (point)) (goto-char p)) |
| 3752 | (if (< p (point)) (goto-char p)) | 3753 | (setq stop t))))))) |
| 3753 | (setq stop t)))))) | ||
| 3754 | 3754 | ||
| 3755 | (defun cperl-after-block-p (lim) | 3755 | (defun cperl-after-block-p (lim) |
| 3756 | ;; We suppose that the preceding char is }. | 3756 | ;; We suppose that the preceding char is }. |
| @@ -3780,8 +3780,8 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', | |||
| 3780 | TEST is the expression to evaluate at the found position. If absent, | 3780 | TEST is the expression to evaluate at the found position. If absent, |
| 3781 | CHARS is a string that contains good characters to have before us (however, | 3781 | CHARS is a string that contains good characters to have before us (however, |
| 3782 | `}' is treated \"smartly\" if it is not in the list)." | 3782 | `}' is treated \"smartly\" if it is not in the list)." |
| 3783 | (let (stop p | 3783 | (let ((lim (or lim (point-min))) |
| 3784 | (lim (or lim (point-min)))) | 3784 | stop p) |
| 3785 | (save-excursion | 3785 | (save-excursion |
| 3786 | (while (and (not stop) (> (point) lim)) | 3786 | (while (and (not stop) (> (point) lim)) |
| 3787 | (skip-chars-backward " \t\n\f" lim) | 3787 | (skip-chars-backward " \t\n\f" lim) |
| @@ -3874,10 +3874,10 @@ Returns some position at the last line." | |||
| 3874 | (interactive) | 3874 | (interactive) |
| 3875 | (or end | 3875 | (or end |
| 3876 | (setq end (point-max))) | 3876 | (setq end (point-max))) |
| 3877 | (let (p pp ml have-brace ret | 3877 | (let ((ee (save-excursion (end-of-line) (point))) |
| 3878 | (ee (save-excursion (end-of-line) (point))) | 3878 | (cperl-indent-region-fix-constructs |
| 3879 | (cperl-indent-region-fix-constructs | 3879 | (or cperl-indent-region-fix-constructs 1)) |
| 3880 | (or cperl-indent-region-fix-constructs 1))) | 3880 | p pp ml have-brace ret) |
| 3881 | (save-excursion | 3881 | (save-excursion |
| 3882 | (beginning-of-line) | 3882 | (beginning-of-line) |
| 3883 | (setq ret (point)) | 3883 | (setq ret (point)) |
| @@ -3887,165 +3887,165 @@ Returns some position at the last line." | |||
| 3887 | (or (looking-at "[ \t]*\\(els\\(e\\|if\\)\\|continue\\|if\\|while\\|for\\(each\\)?\\|until\\)") | 3887 | (or (looking-at "[ \t]*\\(els\\(e\\|if\\)\\|continue\\|if\\|while\\|for\\(each\\)?\\|until\\)") |
| 3888 | (setq have-brace (save-excursion (search-forward "}" ee t))))) | 3888 | (setq have-brace (save-excursion (search-forward "}" ee t))))) |
| 3889 | nil ; Do not need to do anything | 3889 | nil ; Do not need to do anything |
| 3890 | ;; Looking at: | 3890 | ;; Looking at: |
| 3891 | ;; } | 3891 | ;; } |
| 3892 | ;; else | 3892 | ;; else |
| 3893 | (if (and cperl-merge-trailing-else | 3893 | (if (and cperl-merge-trailing-else |
| 3894 | (looking-at | 3894 | (looking-at |
| 3895 | "[ \t]*}[ \t]*\n[ \t\n]*\\(els\\(e\\|if\\)\\|continue\\)\\>")) | 3895 | "[ \t]*}[ \t]*\n[ \t\n]*\\(els\\(e\\|if\\)\\|continue\\)\\>")) |
| 3896 | (progn | 3896 | (progn |
| 3897 | (search-forward "}") | 3897 | (search-forward "}") |
| 3898 | (setq p (point)) | 3898 | (setq p (point)) |
| 3899 | (skip-chars-forward " \t\n") | 3899 | (skip-chars-forward " \t\n") |
| 3900 | (delete-region p (point)) | 3900 | (delete-region p (point)) |
| 3901 | (insert (make-string cperl-indent-region-fix-constructs ?\ )) | 3901 | (insert (make-string cperl-indent-region-fix-constructs ?\ )) |
| 3902 | (beginning-of-line))) | 3902 | (beginning-of-line))) |
| 3903 | ;; Looking at: | 3903 | ;; Looking at: |
| 3904 | ;; } else | 3904 | ;; } else |
| 3905 | (if (looking-at "[ \t]*}\\(\t*\\|[ \t][ \t]+\\)\\<\\(els\\(e\\|if\\)\\|continue\\)\\>") | 3905 | (if (looking-at "[ \t]*}\\(\t*\\|[ \t][ \t]+\\)\\<\\(els\\(e\\|if\\)\\|continue\\)\\>") |
| 3906 | (progn | 3906 | (progn |
| 3907 | (search-forward "}") | 3907 | (search-forward "}") |
| 3908 | (delete-horizontal-space) | 3908 | (delete-horizontal-space) |
| 3909 | (insert (make-string cperl-indent-region-fix-constructs ?\ )) | 3909 | (insert (make-string cperl-indent-region-fix-constructs ?\ )) |
| 3910 | (beginning-of-line))) | 3910 | (beginning-of-line))) |
| 3911 | ;; Looking at: | 3911 | ;; Looking at: |
| 3912 | ;; else { | 3912 | ;; else { |
| 3913 | (if (looking-at | 3913 | (if (looking-at |
| 3914 | "[ \t]*}?[ \t]*\\<\\(\\els\\(e\\|if\\)\\|continue\\|unless\\|if\\|while\\|for\\(each\\)?\\|until\\)\\>\\(\t*\\|[ \t][ \t]+\\)[^ \t\n#]") | 3914 | "[ \t]*}?[ \t]*\\<\\(\\els\\(e\\|if\\)\\|continue\\|unless\\|if\\|while\\|for\\(each\\)?\\|until\\)\\>\\(\t*\\|[ \t][ \t]+\\)[^ \t\n#]") |
| 3915 | (progn | 3915 | (progn |
| 3916 | (forward-word 1) | 3916 | (forward-word 1) |
| 3917 | (delete-horizontal-space) | 3917 | (delete-horizontal-space) |
| 3918 | (insert (make-string cperl-indent-region-fix-constructs ?\ )) | 3918 | (insert (make-string cperl-indent-region-fix-constructs ?\ )) |
| 3919 | (beginning-of-line))) | 3919 | (beginning-of-line))) |
| 3920 | ;; Looking at: | 3920 | ;; Looking at: |
| 3921 | ;; foreach my $var | 3921 | ;; foreach my $var |
| 3922 | (if (looking-at | 3922 | (if (looking-at |
| 3923 | "[ \t]*\\<for\\(each\\)?[ \t]+\\(my\\|local\\|our\\)\\(\t*\\|[ \t][ \t]+\\)[^ \t\n]") | 3923 | "[ \t]*\\<for\\(each\\)?[ \t]+\\(my\\|local\\|our\\)\\(\t*\\|[ \t][ \t]+\\)[^ \t\n]") |
| 3924 | (progn | 3924 | (progn |
| 3925 | (forward-word 2) | 3925 | (forward-word 2) |
| 3926 | (delete-horizontal-space) | 3926 | (delete-horizontal-space) |
| 3927 | (insert (make-string cperl-indent-region-fix-constructs ?\ )) | 3927 | (insert (make-string cperl-indent-region-fix-constructs ?\ )) |
| 3928 | (beginning-of-line))) | 3928 | (beginning-of-line))) |
| 3929 | ;; Looking at: | 3929 | ;; Looking at: |
| 3930 | ;; foreach my $var ( | 3930 | ;; foreach my $var ( |
| 3931 | (if (looking-at | 3931 | (if (looking-at |
| 3932 | "[ \t]*\\<for\\(each\\)?[ \t]+\\(my\\|local\\|our\\)[ \t]*\\$[_a-zA-Z0-9]+\\(\t*\\|[ \t][ \t]+\\)[^ \t\n#]") | 3932 | "[ \t]*\\<for\\(each\\)?[ \t]+\\(my\\|local\\|our\\)[ \t]*\\$[_a-zA-Z0-9]+\\(\t*\\|[ \t][ \t]+\\)[^ \t\n#]") |
| 3933 | (progn | 3933 | (progn |
| 3934 | (forward-word 3) | 3934 | (forward-word 3) |
| 3935 | (delete-horizontal-space) | 3935 | (delete-horizontal-space) |
| 3936 | (insert | 3936 | (insert |
| 3937 | (make-string cperl-indent-region-fix-constructs ?\ )) | 3937 | (make-string cperl-indent-region-fix-constructs ?\ )) |
| 3938 | (beginning-of-line))) | 3938 | (beginning-of-line))) |
| 3939 | ;; Looking at: | 3939 | ;; Looking at: |
| 3940 | ;; } foreach my $var () { | 3940 | ;; } foreach my $var () { |
| 3941 | (if (looking-at | 3941 | (if (looking-at |
| 3942 | "[ \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]*{") | 3942 | "[ \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]*{") |
| 3943 | (progn | 3943 | (progn |
| 3944 | (setq ml (match-beginning 8)) | 3944 | (setq ml (match-beginning 8)) |
| 3945 | (re-search-forward "[({]") | 3945 | (re-search-forward "[({]") |
| 3946 | (forward-char -1) | 3946 | (forward-char -1) |
| 3947 | (setq p (point)) | 3947 | (setq p (point)) |
| 3948 | (if (eq (following-char) ?\( ) | 3948 | (if (eq (following-char) ?\( ) |
| 3949 | (progn | 3949 | (progn |
| 3950 | (forward-sexp 1) | 3950 | (forward-sexp 1) |
| 3951 | (setq pp (point))) | 3951 | (setq pp (point))) |
| 3952 | ;; after `else' or nothing | 3952 | ;; after `else' or nothing |
| 3953 | (if ml ; after `else' | 3953 | (if ml ; after `else' |
| 3954 | (skip-chars-backward " \t\n") | 3954 | (skip-chars-backward " \t\n") |
| 3955 | (beginning-of-line)) | 3955 | (beginning-of-line)) |
| 3956 | (setq pp nil)) | 3956 | (setq pp nil)) |
| 3957 | ;; Now after the sexp before the brace | 3957 | ;; Now after the sexp before the brace |
| 3958 | ;; Multiline expr should be special | 3958 | ;; Multiline expr should be special |
| 3959 | (setq ml (and pp (save-excursion (goto-char p) | 3959 | (setq ml (and pp (save-excursion (goto-char p) |
| 3960 | (search-forward "\n" pp t)))) | 3960 | (search-forward "\n" pp t)))) |
| 3961 | (if (and (or (not pp) (< pp end)) | 3961 | (if (and (or (not pp) (< pp end)) |
| 3962 | (looking-at "[ \t\n]*{")) | 3962 | (looking-at "[ \t\n]*{")) |
| 3963 | (progn | 3963 | (progn |
| 3964 | (cond | 3964 | (cond |
| 3965 | ((bolp) ; Were before `{', no if/else/etc | 3965 | ((bolp) ; Were before `{', no if/else/etc |
| 3966 | nil) | 3966 | nil) |
| 3967 | ((looking-at "\\(\t*\\| [ \t]+\\){") | 3967 | ((looking-at "\\(\t*\\| [ \t]+\\){") |
| 3968 | (delete-horizontal-space) | 3968 | (delete-horizontal-space) |
| 3969 | (if (if ml | 3969 | (if (if ml |
| 3970 | cperl-extra-newline-before-brace-multiline | 3970 | cperl-extra-newline-before-brace-multiline |
| 3971 | cperl-extra-newline-before-brace) | 3971 | cperl-extra-newline-before-brace) |
| 3972 | (progn | 3972 | (progn |
| 3973 | (delete-horizontal-space) | 3973 | (delete-horizontal-space) |
| 3974 | (insert "\n") | 3974 | (insert "\n") |
| 3975 | (setq ret (point)) | 3975 | (setq ret (point)) |
| 3976 | (if (cperl-indent-line parse-data) | 3976 | (if (cperl-indent-line parse-data) |
| 3977 | (progn | 3977 | (progn |
| 3978 | (cperl-fix-line-spacing end parse-data) | 3978 | (cperl-fix-line-spacing end parse-data) |
| 3979 | (setq ret (point))))) | 3979 | (setq ret (point))))) |
| 3980 | (insert | ||
| 3981 | (make-string cperl-indent-region-fix-constructs ?\ )))) | ||
| 3982 | ((and (looking-at "[ \t]*\n") | ||
| 3983 | (not (if ml | ||
| 3984 | cperl-extra-newline-before-brace-multiline | ||
| 3985 | cperl-extra-newline-before-brace))) | ||
| 3986 | (setq pp (point)) | ||
| 3987 | (skip-chars-forward " \t\n") | ||
| 3988 | (delete-region pp (point)) | ||
| 3980 | (insert | 3989 | (insert |
| 3981 | (make-string cperl-indent-region-fix-constructs ?\ )))) | 3990 | (make-string cperl-indent-region-fix-constructs ?\ )))) |
| 3982 | ((and (looking-at "[ \t]*\n") | 3991 | ;; Now we are before `{' |
| 3983 | (not (if ml | 3992 | (if (looking-at "[ \t\n]*{[ \t]*[^ \t\n#]") |
| 3984 | cperl-extra-newline-before-brace-multiline | 3993 | (progn |
| 3985 | cperl-extra-newline-before-brace))) | 3994 | (skip-chars-forward " \t\n") |
| 3986 | (setq pp (point)) | 3995 | (setq pp (point)) |
| 3987 | (skip-chars-forward " \t\n") | 3996 | (forward-sexp 1) |
| 3988 | (delete-region pp (point)) | 3997 | (setq p (point)) |
| 3989 | (insert | 3998 | (goto-char pp) |
| 3990 | (make-string cperl-indent-region-fix-constructs ?\ )))) | 3999 | (setq ml (search-forward "\n" p t)) |
| 3991 | ;; Now we are before `{' | 4000 | (if (or cperl-break-one-line-blocks-when-indent ml) |
| 3992 | (if (looking-at "[ \t\n]*{[ \t]*[^ \t\n#]") | 4001 | ;; not good: multi-line BLOCK |
| 3993 | (progn | 4002 | (progn |
| 3994 | (skip-chars-forward " \t\n") | 4003 | (goto-char (1+ pp)) |
| 3995 | (setq pp (point)) | 4004 | (delete-horizontal-space) |
| 3996 | (forward-sexp 1) | 4005 | (insert "\n") |
| 3997 | (setq p (point)) | 4006 | (setq ret (point)) |
| 3998 | (goto-char pp) | 4007 | (if (cperl-indent-line parse-data) |
| 3999 | (setq ml (search-forward "\n" p t)) | 4008 | (setq ret (cperl-fix-line-spacing end parse-data))))))))))) |
| 4000 | (if (or cperl-break-one-line-blocks-when-indent ml) | 4009 | (beginning-of-line) |
| 4001 | ;; not good: multi-line BLOCK | 4010 | (setq p (point) pp (save-excursion (end-of-line) (point))) ; May be different from ee. |
| 4002 | (progn | 4011 | ;; Now check whether there is a hanging `}' |
| 4003 | (goto-char (1+ pp)) | 4012 | ;; Looking at: |
| 4004 | (delete-horizontal-space) | 4013 | ;; } blah |
| 4005 | (insert "\n") | 4014 | (if (and |
| 4006 | (setq ret (point)) | 4015 | cperl-fix-hanging-brace-when-indent |
| 4007 | (if (cperl-indent-line parse-data) | 4016 | have-brace |
| 4008 | (setq ret (cperl-fix-line-spacing end parse-data))))))))))) | 4017 | (not (looking-at "[ \t]*}[ \t]*\\(\\<\\(els\\(if\\|e\\)\\|continue\\|while\\|until\\)\\>\\|$\\|#\\)")) |
| 4009 | (beginning-of-line) | 4018 | (condition-case nil |
| 4010 | (setq p (point) pp (save-excursion (end-of-line) (point))) ; May be different from ee. | 4019 | (progn |
| 4011 | ;; Now check whether there is a hanging `}' | 4020 | (up-list 1) |
| 4012 | ;; Looking at: | 4021 | (if (and (<= (point) pp) |
| 4013 | ;; } blah | 4022 | (eq (preceding-char) ?\} ) |
| 4014 | (if (and | 4023 | (cperl-after-block-and-statement-beg (point-min))) |
| 4015 | cperl-fix-hanging-brace-when-indent | 4024 | t |
| 4016 | have-brace | 4025 | (goto-char p) |
| 4017 | (not (looking-at "[ \t]*}[ \t]*\\(\\<\\(els\\(if\\|e\\)\\|continue\\|while\\|until\\)\\>\\|$\\|#\\)")) | 4026 | nil)) |
| 4018 | (condition-case nil | 4027 | (error nil))) |
| 4019 | (progn | 4028 | (progn |
| 4020 | (up-list 1) | 4029 | (forward-char -1) |
| 4021 | (if (and (<= (point) pp) | 4030 | (skip-chars-backward " \t") |
| 4022 | (eq (preceding-char) ?\} ) | 4031 | (if (bolp) |
| 4023 | (cperl-after-block-and-statement-beg (point-min))) | 4032 | ;; `}' was the first thing on the line, insert NL *after* it. |
| 4024 | t | 4033 | (progn |
| 4025 | (goto-char p) | 4034 | (cperl-indent-line parse-data) |
| 4026 | nil)) | 4035 | (search-forward "}") |
| 4027 | (error nil))) | 4036 | (delete-horizontal-space) |
| 4028 | (progn | 4037 | (insert "\n")) |
| 4029 | (forward-char -1) | 4038 | (delete-horizontal-space) |
| 4030 | (skip-chars-backward " \t") | 4039 | (or (eq (preceding-char) ?\;) |
| 4031 | (if (bolp) | 4040 | (bolp) |
| 4032 | ;; `}' was the first thing on the line, insert NL *after* it. | 4041 | (and (eq (preceding-char) ?\} ) |
| 4033 | (progn | 4042 | (cperl-after-block-p (point-min))) |
| 4034 | (cperl-indent-line parse-data) | 4043 | (insert ";")) |
| 4035 | (search-forward "}") | 4044 | (insert "\n") |
| 4036 | (delete-horizontal-space) | 4045 | (setq ret (point))) |
| 4037 | (insert "\n")) | 4046 | (if (cperl-indent-line parse-data) |
| 4038 | (delete-horizontal-space) | 4047 | (setq ret (cperl-fix-line-spacing end parse-data))) |
| 4039 | (or (eq (preceding-char) ?\;) | 4048 | (beginning-of-line))))) |
| 4040 | (bolp) | ||
| 4041 | (and (eq (preceding-char) ?\} ) | ||
| 4042 | (cperl-after-block-p (point-min))) | ||
| 4043 | (insert ";")) | ||
| 4044 | (insert "\n") | ||
| 4045 | (setq ret (point))) | ||
| 4046 | (if (cperl-indent-line parse-data) | ||
| 4047 | (setq ret (cperl-fix-line-spacing end parse-data))) | ||
| 4048 | (beginning-of-line))))) | ||
| 4049 | ret)) | 4049 | ret)) |
| 4050 | 4050 | ||
| 4051 | (defvar cperl-update-start) ; Do not need to make them local | 4051 | (defvar cperl-update-start) ; Do not need to make them local |
| @@ -4067,32 +4067,32 @@ conditional/loop constructs." | |||
| 4067 | (cperl-update-syntaxification end end) | 4067 | (cperl-update-syntaxification end end) |
| 4068 | (save-excursion | 4068 | (save-excursion |
| 4069 | (let (cperl-update-start cperl-update-end (h-a-c after-change-functions)) | 4069 | (let (cperl-update-start cperl-update-end (h-a-c after-change-functions)) |
| 4070 | (let (st comm old-comm-indent new-comm-indent p pp i empty | 4070 | (let ((indent-info (if cperl-emacs-can-parse |
| 4071 | (indent-info (if cperl-emacs-can-parse | 4071 | (list nil nil nil) ; Cannot use '(), since will modify |
| 4072 | (list nil nil nil) ; Cannot use '(), since will modify | 4072 | nil)) |
| 4073 | nil)) | 4073 | (pm 0) (imenu-scanning-message "Indenting... (%3d%%)") |
| 4074 | after-change-functions ; Speed it up! | 4074 | after-change-functions ; Speed it up! |
| 4075 | (pm 0) (imenu-scanning-message "Indenting... (%3d%%)")) | 4075 | st comm old-comm-indent new-comm-indent p pp i empty) |
| 4076 | (if h-a-c (add-hook 'after-change-functions 'cperl-delay-update-hook)) | 4076 | (if h-a-c (add-hook 'after-change-functions 'cperl-delay-update-hook)) |
| 4077 | (goto-char start) | 4077 | (goto-char start) |
| 4078 | (setq old-comm-indent (and (cperl-to-comment-or-eol) | 4078 | (setq old-comm-indent (and (cperl-to-comment-or-eol) |
| 4079 | (current-column)) | 4079 | (current-column)) |
| 4080 | new-comm-indent old-comm-indent) | 4080 | new-comm-indent old-comm-indent) |
| 4081 | (goto-char start) | 4081 | (goto-char start) |
| 4082 | (setq end (set-marker (make-marker) end)) ; indentation changes pos | 4082 | (setq end (set-marker (make-marker) end)) ; indentation changes pos |
| 4083 | (or (bolp) (beginning-of-line 2)) | 4083 | (or (bolp) (beginning-of-line 2)) |
| 4084 | (or (fboundp 'imenu-progress-message) | 4084 | (or (fboundp 'imenu-progress-message) |
| 4085 | (message "Indenting... For feedback load `imenu'...")) | 4085 | (message "Indenting... For feedback load `imenu'...")) |
| 4086 | (while (and (<= (point) end) (not (eobp))) ; bol to check start | 4086 | (while (and (<= (point) end) (not (eobp))) ; bol to check start |
| 4087 | (and (fboundp 'imenu-progress-message) | 4087 | (and (fboundp 'imenu-progress-message) |
| 4088 | (imenu-progress-message | 4088 | (imenu-progress-message |
| 4089 | pm (/ (* 100 (- (point) start)) (- end start -1)))) | 4089 | pm (/ (* 100 (- (point) start)) (- end start -1)))) |
| 4090 | (setq st (point)) | 4090 | (setq st (point)) |
| 4091 | (if (or | 4091 | (if (or |
| 4092 | (setq empty (looking-at "[ \t]*\n")) | 4092 | (setq empty (looking-at "[ \t]*\n")) |
| 4093 | (and (setq comm (looking-at "[ \t]*#")) | 4093 | (and (setq comm (looking-at "[ \t]*#")) |
| 4094 | (or (eq (current-indentation) (or old-comm-indent | 4094 | (or (eq (current-indentation) (or old-comm-indent |
| 4095 | comment-column)) | 4095 | comment-column)) |
| 4096 | (setq old-comm-indent nil)))) | 4096 | (setq old-comm-indent nil)))) |
| 4097 | (if (and old-comm-indent | 4097 | (if (and old-comm-indent |
| 4098 | (not empty) | 4098 | (not empty) |
| @@ -4100,20 +4100,20 @@ conditional/loop constructs." | |||
| 4100 | (not (eq (get-text-property (point) 'syntax-type) 'pod)) | 4100 | (not (eq (get-text-property (point) 'syntax-type) 'pod)) |
| 4101 | (not (eq (get-text-property (point) 'syntax-table) | 4101 | (not (eq (get-text-property (point) 'syntax-table) |
| 4102 | cperl-st-cfence))) | 4102 | cperl-st-cfence))) |
| 4103 | (let ((comment-column new-comm-indent)) | 4103 | (let ((comment-column new-comm-indent)) |
| 4104 | (indent-for-comment))) | 4104 | (indent-for-comment))) |
| 4105 | (progn | 4105 | (progn |
| 4106 | (setq i (cperl-indent-line indent-info)) | 4106 | (setq i (cperl-indent-line indent-info)) |
| 4107 | (or comm | 4107 | (or comm |
| 4108 | (not i) | 4108 | (not i) |
| 4109 | (progn | 4109 | (progn |
| 4110 | (if cperl-indent-region-fix-constructs | 4110 | (if cperl-indent-region-fix-constructs |
| 4111 | (goto-char (cperl-fix-line-spacing end indent-info))) | 4111 | (goto-char (cperl-fix-line-spacing end indent-info))) |
| 4112 | (if (setq old-comm-indent | 4112 | (if (setq old-comm-indent |
| 4113 | (and (cperl-to-comment-or-eol) | 4113 | (and (cperl-to-comment-or-eol) |
| 4114 | (not (memq (get-text-property (point) | 4114 | (not (memq (get-text-property (point) |
| 4115 | 'syntax-type) | 4115 | 'syntax-type) |
| 4116 | '(pod here-doc))) | 4116 | '(pod here-doc))) |
| 4117 | (not (eq (get-text-property (point) | 4117 | (not (eq (get-text-property (point) |
| 4118 | 'syntax-table) | 4118 | 'syntax-table) |
| 4119 | cperl-st-cfence)) | 4119 | cperl-st-cfence)) |
| @@ -4127,16 +4127,15 @@ conditional/loop constructs." | |||
| 4127 | (imenu-progress-message pm 100) | 4127 | (imenu-progress-message pm 100) |
| 4128 | (message nil))) | 4128 | (message nil))) |
| 4129 | ;; Now run the update hooks | 4129 | ;; Now run the update hooks |
| 4130 | (if after-change-functions | 4130 | (and after-change-functions |
| 4131 | (save-excursion | 4131 | cperl-update-end |
| 4132 | (if cperl-update-end | 4132 | (save-excursion |
| 4133 | (progn | 4133 | (goto-char cperl-update-end) |
| 4134 | (goto-char cperl-update-end) | 4134 | (insert " ") |
| 4135 | (insert " ") | 4135 | (delete-char -1) |
| 4136 | (delete-char -1) | 4136 | (goto-char cperl-update-start) |
| 4137 | (goto-char cperl-update-start) | 4137 | (insert " ") |
| 4138 | (insert " ") | 4138 | (delete-char -1)))))) |
| 4139 | (delete-char -1)))))))) | ||
| 4140 | 4139 | ||
| 4141 | ;; Stolen from lisp-mode with a lot of improvements | 4140 | ;; Stolen from lisp-mode with a lot of improvements |
| 4142 | 4141 | ||
| @@ -4146,8 +4145,7 @@ If any of the current line is a comment, fill the comment or the | |||
| 4146 | block of it that point is in, preserving the comment's initial | 4145 | block of it that point is in, preserving the comment's initial |
| 4147 | indentation and initial hashes. Behaves usually outside of comment." | 4146 | indentation and initial hashes. Behaves usually outside of comment." |
| 4148 | (interactive "P") | 4147 | (interactive "P") |
| 4149 | (let ( | 4148 | (let (;; Non-nil if the current line contains a comment. |
| 4150 | ;; Non-nil if the current line contains a comment. | ||
| 4151 | has-comment | 4149 | has-comment |
| 4152 | 4150 | ||
| 4153 | ;; If has-comment, the appropriate fill-prefix for the comment. | 4151 | ;; If has-comment, the appropriate fill-prefix for the comment. |
| @@ -4183,7 +4181,7 @@ indentation and initial hashes. Behaves usually outside of comment." | |||
| 4183 | (delete-char len) | 4181 | (delete-char len) |
| 4184 | (insert (make-string dc ?-))))) | 4182 | (insert (make-string dc ?-))))) |
| 4185 | (if (not has-comment) | 4183 | (if (not has-comment) |
| 4186 | (fill-paragraph justify) ; Do the usual thing outside of comment | 4184 | (fill-paragraph justify) ; Do the usual thing outside of comment |
| 4187 | ;; Narrow to include only the comment, and then fill the region. | 4185 | ;; Narrow to include only the comment, and then fill the region. |
| 4188 | (save-restriction | 4186 | (save-restriction |
| 4189 | (narrow-to-region | 4187 | (narrow-to-region |
| @@ -4217,7 +4215,7 @@ indentation and initial hashes. Behaves usually outside of comment." | |||
| 4217 | (progn | 4215 | (progn |
| 4218 | (goto-char start) | 4216 | (goto-char start) |
| 4219 | (if (> dc 0) | 4217 | (if (> dc 0) |
| 4220 | (progn (delete-char dc) (insert spaces))) | 4218 | (progn (delete-char dc) (insert spaces))) |
| 4221 | (if (or (= (current-column) c) iteration) nil | 4219 | (if (or (= (current-column) c) iteration) nil |
| 4222 | (setq comment-column c) | 4220 | (setq comment-column c) |
| 4223 | (indent-for-comment) | 4221 | (indent-for-comment) |
| @@ -4230,22 +4228,22 @@ indentation and initial hashes. Behaves usually outside of comment." | |||
| 4230 | (end-of-line) | 4228 | (end-of-line) |
| 4231 | (current-column)) | 4229 | (current-column)) |
| 4232 | fill-column) | 4230 | fill-column) |
| 4233 | (let ((c (save-excursion (beginning-of-line) | 4231 | (let ((c (save-excursion (beginning-of-line) |
| 4234 | (cperl-to-comment-or-eol) (point))) | 4232 | (cperl-to-comment-or-eol) (point))) |
| 4235 | (s (memq (following-char) '(?\ ?\t))) marker) | 4233 | (s (memq (following-char) '(?\ ?\t))) marker) |
| 4236 | (if (>= c (point)) nil | 4234 | (if (>= c (point)) nil |
| 4237 | (setq marker (point-marker)) | 4235 | (setq marker (point-marker)) |
| 4238 | (cperl-fill-paragraph) | 4236 | (cperl-fill-paragraph) |
| 4239 | (goto-char marker) | 4237 | (goto-char marker) |
| 4240 | ;; Is not enough, sometimes marker is a start of line | 4238 | ;; Is not enough, sometimes marker is a start of line |
| 4241 | (if (bolp) (progn (re-search-forward "#+[ \t]*") | 4239 | (if (bolp) (progn (re-search-forward "#+[ \t]*") |
| 4242 | (goto-char (match-end 0)))) | 4240 | (goto-char (match-end 0)))) |
| 4243 | ;; Following space could have gone: | 4241 | ;; Following space could have gone: |
| 4244 | (if (or (not s) (memq (following-char) '(?\ ?\t))) nil | 4242 | (if (or (not s) (memq (following-char) '(?\ ?\t))) nil |
| 4245 | (insert " ") | 4243 | (insert " ") |
| 4246 | (backward-char 1)) | 4244 | (backward-char 1)) |
| 4247 | ;; Previous space could have gone: | 4245 | ;; Previous space could have gone: |
| 4248 | (or (memq (preceding-char) '(?\ ?\t)) (insert " ")))))) | 4246 | (or (memq (preceding-char) '(?\ ?\t)) (insert " ")))))) |
| 4249 | 4247 | ||
| 4250 | (defun cperl-imenu-addback (lst &optional isback name) | 4248 | (defun cperl-imenu-addback (lst &optional isback name) |
| 4251 | ;; We suppose that the lst is a DAG, unless the first element only | 4249 | ;; We suppose that the lst is a DAG, unless the first element only |
| @@ -4255,15 +4253,14 @@ indentation and initial hashes. Behaves usually outside of comment." | |||
| 4255 | (t | 4253 | (t |
| 4256 | (or name | 4254 | (or name |
| 4257 | (setq name "+++BACK+++")) | 4255 | (setq name "+++BACK+++")) |
| 4258 | (mapcar (function (lambda (elt) | 4256 | (mapcar (lambda (elt) |
| 4259 | (if (and (listp elt) (listp (cdr elt))) | 4257 | (if (and (listp elt) (listp (cdr elt))) |
| 4260 | (progn | 4258 | (progn |
| 4261 | ;; In the other order it goes up | 4259 | ;; In the other order it goes up |
| 4262 | ;; one level only ;-( | 4260 | ;; one level only ;-( |
| 4263 | (setcdr elt (cons (cons name lst) | 4261 | (setcdr elt (cons (cons name lst) |
| 4264 | (cdr elt))) | 4262 | (cdr elt))) |
| 4265 | (cperl-imenu-addback (cdr elt) t name) | 4263 | (cperl-imenu-addback (cdr elt) t name)))) |
| 4266 | )))) | ||
| 4267 | (if isback (cdr lst) lst)) | 4264 | (if isback (cdr lst) lst)) |
| 4268 | lst))) | 4265 | lst))) |
| 4269 | 4266 | ||
| @@ -4291,7 +4288,7 @@ indentation and initial hashes. Behaves usually outside of comment." | |||
| 4291 | (match-beginning 2) ; package or sub | 4288 | (match-beginning 2) ; package or sub |
| 4292 | (eq (char-after (match-beginning 2)) ?p) ; package | 4289 | (eq (char-after (match-beginning 2)) ?p) ; package |
| 4293 | (not (save-match-data | 4290 | (not (save-match-data |
| 4294 | (looking-at "[ \t\n]*;")))) ; Plain text word 'package' | 4291 | (looking-at "[ \t\n]*;")))) ; Plain text word 'package' |
| 4295 | nil) | 4292 | nil) |
| 4296 | ((and | 4293 | ((and |
| 4297 | (match-beginning 2) ; package or sub | 4294 | (match-beginning 2) ; package or sub |
| @@ -4301,8 +4298,7 @@ indentation and initial hashes. Behaves usually outside of comment." | |||
| 4301 | (null (get-text-property (match-beginning 1) 'in-pod))) | 4298 | (null (get-text-property (match-beginning 1) 'in-pod))) |
| 4302 | (save-excursion | 4299 | (save-excursion |
| 4303 | (goto-char (match-beginning 2)) | 4300 | (goto-char (match-beginning 2)) |
| 4304 | (setq fchar (following-char)) | 4301 | (setq fchar (following-char))) |
| 4305 | ) | ||
| 4306 | ;; (if (looking-at "([^()]*)[ \t\n\f]*") | 4302 | ;; (if (looking-at "([^()]*)[ \t\n\f]*") |
| 4307 | ;; (goto-char (match-end 0))) ; Messes what follows | 4303 | ;; (goto-char (match-end 0))) ; Messes what follows |
| 4308 | (setq char (following-char) ; ?\; for "sub foo () ;" | 4304 | (setq char (following-char) ; ?\; for "sub foo () ;" |
| @@ -4345,7 +4341,7 @@ indentation and initial hashes. Behaves usually outside of comment." | |||
| 4345 | (push index index-alist)) | 4341 | (push index index-alist)) |
| 4346 | (if meth (push index index-meth-alist)) | 4342 | (if meth (push index index-meth-alist)) |
| 4347 | (push index index-unsorted-alist))) | 4343 | (push index index-unsorted-alist))) |
| 4348 | ((match-beginning 5) ; Pod section | 4344 | ((match-beginning 5) ; POD section |
| 4349 | ;; (beginning-of-line) | 4345 | ;; (beginning-of-line) |
| 4350 | (setq index (imenu-example--name-and-position) | 4346 | (setq index (imenu-example--name-and-position) |
| 4351 | name (buffer-substring (match-beginning 6) (match-end 6))) | 4347 | name (buffer-substring (match-beginning 6) (match-end 6))) |
| @@ -4361,7 +4357,7 @@ indentation and initial hashes. Behaves usually outside of comment." | |||
| 4361 | (setq index-alist | 4357 | (setq index-alist |
| 4362 | (if (default-value 'imenu-sort-function) | 4358 | (if (default-value 'imenu-sort-function) |
| 4363 | (sort index-alist (default-value 'imenu-sort-function)) | 4359 | (sort index-alist (default-value 'imenu-sort-function)) |
| 4364 | (nreverse index-alist))) | 4360 | (nreverse index-alist))) |
| 4365 | (and index-pod-alist | 4361 | (and index-pod-alist |
| 4366 | (push (cons "+POD headers+..." | 4362 | (push (cons "+POD headers+..." |
| 4367 | (nreverse index-pod-alist)) | 4363 | (nreverse index-pod-alist)) |
| @@ -4437,9 +4433,9 @@ indentation and initial hashes. Behaves usually outside of comment." | |||
| 4437 | 4433 | ||
| 4438 | (if (fboundp 'eval-after-load) | 4434 | (if (fboundp 'eval-after-load) |
| 4439 | (eval-after-load | 4435 | (eval-after-load |
| 4440 | "mode-compile" | 4436 | "mode-compile" |
| 4441 | '(setq perl-compilation-error-regexp-alist | 4437 | '(setq perl-compilation-error-regexp-alist |
| 4442 | cperl-compilation-error-regexp-alist))) | 4438 | cperl-compilation-error-regexp-alist))) |
| 4443 | 4439 | ||
| 4444 | 4440 | ||
| 4445 | (defun cperl-windowed-init () | 4441 | (defun cperl-windowed-init () |
| @@ -4455,8 +4451,8 @@ indentation and initial hashes. Behaves usually outside of comment." | |||
| 4455 | (or cperl-faces-init (cperl-init-faces))))))) | 4451 | (or cperl-faces-init (cperl-init-faces))))))) |
| 4456 | (if (fboundp 'eval-after-load) | 4452 | (if (fboundp 'eval-after-load) |
| 4457 | (eval-after-load | 4453 | (eval-after-load |
| 4458 | "ps-print" | 4454 | "ps-print" |
| 4459 | '(or cperl-faces-init (cperl-init-faces)))))) | 4455 | '(or cperl-faces-init (cperl-init-faces)))))) |
| 4460 | 4456 | ||
| 4461 | (defvar cperl-font-lock-keywords-1 nil | 4457 | (defvar cperl-font-lock-keywords-1 nil |
| 4462 | "Additional expressions to highlight in Perl mode. Minimal set.") | 4458 | "Additional expressions to highlight in Perl mode. Minimal set.") |
| @@ -4633,7 +4629,7 @@ indentation and initial hashes. Behaves usually outside of comment." | |||
| 4633 | '("[\[ \t{,(]\\(-?[a-zA-Z0-9_:]+\\)[ \t]*=>" 1 | 4629 | '("[\[ \t{,(]\\(-?[a-zA-Z0-9_:]+\\)[ \t]*=>" 1 |
| 4634 | font-lock-string-face t) | 4630 | font-lock-string-face t) |
| 4635 | '("^[ \t]*\\([a-zA-Z0-9_]+[ \t]*:\\)[ \t]*\\($\\|{\\|\\<\\(until\\|while\\|for\\(each\\)?\\|do\\)\\>\\)" 1 | 4631 | '("^[ \t]*\\([a-zA-Z0-9_]+[ \t]*:\\)[ \t]*\\($\\|{\\|\\<\\(until\\|while\\|for\\(each\\)?\\|do\\)\\>\\)" 1 |
| 4636 | font-lock-constant-face) ; labels | 4632 | font-lock-constant-face) ; labels |
| 4637 | '("\\<\\(continue\\|next\\|last\\|redo\\|goto\\)\\>[ \t]+\\([a-zA-Z0-9_:]+\\)" ; labels as targets | 4633 | '("\\<\\(continue\\|next\\|last\\|redo\\|goto\\)\\>[ \t]+\\([a-zA-Z0-9_:]+\\)" ; labels as targets |
| 4638 | 2 font-lock-constant-face) | 4634 | 2 font-lock-constant-face) |
| 4639 | ;; Uncomment to get perl-mode-like vars | 4635 | ;; Uncomment to get perl-mode-like vars |
| @@ -4661,7 +4657,7 @@ indentation and initial hashes. Behaves usually outside of comment." | |||
| 4661 | (setq | 4657 | (setq |
| 4662 | t-font-lock-keywords-1 | 4658 | t-font-lock-keywords-1 |
| 4663 | (and (fboundp 'turn-on-font-lock) ; Check for newer font-lock | 4659 | (and (fboundp 'turn-on-font-lock) ; Check for newer font-lock |
| 4664 | (not cperl-xemacs-p) ; not yet as of XEmacs 19.12 | 4660 | (not cperl-xemacs-p) ; not yet as of XEmacs 19.12 |
| 4665 | '( | 4661 | '( |
| 4666 | ("\\(\\([@%]\\|\$#\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)" 1 | 4662 | ("\\(\\([@%]\\|\$#\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)" 1 |
| 4667 | (if (eq (char-after (match-beginning 2)) ?%) | 4663 | (if (eq (char-after (match-beginning 2)) ?%) |
| @@ -4701,85 +4697,82 @@ indentation and initial hashes. Behaves usually outside of comment." | |||
| 4701 | (if (fboundp 'ps-print-buffer) (cperl-ps-print-init)) | 4697 | (if (fboundp 'ps-print-buffer) (cperl-ps-print-init)) |
| 4702 | (if (or (featurep 'choose-color) (featurep 'font-lock-extra)) | 4698 | (if (or (featurep 'choose-color) (featurep 'font-lock-extra)) |
| 4703 | (eval ; Avoid a warning | 4699 | (eval ; Avoid a warning |
| 4704 | '(font-lock-require-faces | 4700 | '(font-lock-require-faces |
| 4705 | (list | 4701 | (list |
| 4706 | ;; Color-light Color-dark Gray-light Gray-dark Mono | 4702 | ;; Color-light Color-dark Gray-light Gray-dark Mono |
| 4707 | (list 'font-lock-comment-face | 4703 | (list 'font-lock-comment-face |
| 4708 | ["Firebrick" "OrangeRed" "DimGray" "Gray80"] | 4704 | ["Firebrick" "OrangeRed" "DimGray" "Gray80"] |
| 4709 | nil | 4705 | nil |
| 4710 | [nil nil t t t] | 4706 | [nil nil t t t] |
| 4711 | [nil nil t t t] | 4707 | [nil nil t t t] |
| 4712 | nil) | 4708 | nil) |
| 4713 | (list 'font-lock-string-face | 4709 | (list 'font-lock-string-face |
| 4714 | ["RosyBrown" "LightSalmon" "Gray50" "LightGray"] | 4710 | ["RosyBrown" "LightSalmon" "Gray50" "LightGray"] |
| 4715 | nil | 4711 | nil |
| 4716 | nil | 4712 | nil |
| 4717 | [nil nil t t t] | 4713 | [nil nil t t t] |
| 4718 | nil) | 4714 | nil) |
| 4719 | (list 'font-lock-function-name-face | 4715 | (list 'font-lock-function-name-face |
| 4720 | (vector | 4716 | (vector |
| 4721 | "Blue" "LightSkyBlue" "Gray50" "LightGray" | 4717 | "Blue" "LightSkyBlue" "Gray50" "LightGray" |
| 4722 | (cdr (assq 'background-color ; if mono | 4718 | (cdr (assq 'background-color ; if mono |
| 4723 | (frame-parameters)))) | 4719 | (frame-parameters)))) |
| 4724 | (vector | 4720 | (vector |
| 4725 | nil nil nil nil | 4721 | nil nil nil nil |
| 4726 | (cdr (assq 'foreground-color ; if mono | 4722 | (cdr (assq 'foreground-color ; if mono |
| 4727 | (frame-parameters)))) | 4723 | (frame-parameters)))) |
| 4728 | [nil nil t t t] | 4724 | [nil nil t t t] |
| 4729 | nil | 4725 | nil |
| 4730 | nil) | 4726 | nil) |
| 4731 | (list 'font-lock-variable-name-face | 4727 | (list 'font-lock-variable-name-face |
| 4732 | ["DarkGoldenrod" "LightGoldenrod" "DimGray" "Gray90"] | 4728 | ["DarkGoldenrod" "LightGoldenrod" "DimGray" "Gray90"] |
| 4733 | nil | 4729 | nil |
| 4734 | [nil nil t t t] | 4730 | [nil nil t t t] |
| 4735 | [nil nil t t t] | 4731 | [nil nil t t t] |
| 4736 | nil) | 4732 | nil) |
| 4737 | (list 'font-lock-type-face | 4733 | (list 'font-lock-type-face |
| 4738 | ["DarkOliveGreen" "PaleGreen" "DimGray" "Gray80"] | 4734 | ["DarkOliveGreen" "PaleGreen" "DimGray" "Gray80"] |
| 4739 | nil | 4735 | nil |
| 4740 | [nil nil t t t] | 4736 | [nil nil t t t] |
| 4741 | nil | 4737 | nil |
| 4742 | [nil nil t t t] | 4738 | [nil nil t t t]) |
| 4743 | ) | 4739 | (list 'font-lock-constant-face |
| 4744 | (list 'font-lock-constant-face | 4740 | ["CadetBlue" "Aquamarine" "Gray50" "LightGray"] |
| 4745 | ["CadetBlue" "Aquamarine" "Gray50" "LightGray"] | 4741 | nil |
| 4746 | nil | 4742 | [nil nil t t t] |
| 4747 | [nil nil t t t] | 4743 | nil |
| 4748 | nil | 4744 | [nil nil t t t]) |
| 4749 | [nil nil t t t] | 4745 | (list 'cperl-nonoverridable-face |
| 4750 | ) | 4746 | ["chartreuse3" ("orchid1" "orange") |
| 4751 | (list 'cperl-nonoverridable-face | 4747 | nil "Gray80"] |
| 4752 | ["chartreuse3" ("orchid1" "orange") | 4748 | [nil nil "gray90"] |
| 4753 | nil "Gray80"] | 4749 | [nil nil nil t t] |
| 4754 | [nil nil "gray90"] | 4750 | [nil nil t t] |
| 4755 | [nil nil nil t t] | 4751 | [nil nil t t t]) |
| 4756 | [nil nil t t] | 4752 | (list 'cperl-array-face |
| 4757 | [nil nil t t t] | 4753 | ["blue" "yellow" nil "Gray80"] |
| 4758 | ) | 4754 | ["lightyellow2" ("navy" "os2blue" "darkgreen") |
| 4759 | (list 'cperl-array-face | 4755 | "gray90"] |
| 4760 | ["blue" "yellow" nil "Gray80"] | 4756 | t |
| 4761 | ["lightyellow2" ("navy" "os2blue" "darkgreen") | 4757 | nil |
| 4762 | "gray90"] | 4758 | nil) |
| 4763 | t | 4759 | (list 'cperl-hash-face |
| 4764 | nil | 4760 | ["red" "red" nil "Gray80"] |
| 4765 | nil) | 4761 | ["lightyellow2" ("navy" "os2blue" "darkgreen") |
| 4766 | (list 'cperl-hash-face | 4762 | "gray90"] |
| 4767 | ["red" "red" nil "Gray80"] | 4763 | t |
| 4768 | ["lightyellow2" ("navy" "os2blue" "darkgreen") | 4764 | t |
| 4769 | "gray90"] | 4765 | nil)))) |
| 4770 | t | ||
| 4771 | t | ||
| 4772 | nil)))) | ||
| 4773 | ;; Do it the dull way, without choose-color | 4766 | ;; Do it the dull way, without choose-color |
| 4774 | (defvar cperl-guessed-background nil | 4767 | (defvar cperl-guessed-background nil |
| 4775 | "Display characteristics as guessed by cperl.") | 4768 | "Display characteristics as guessed by cperl.") |
| 4776 | ;; (or (fboundp 'x-color-defined-p) | 4769 | ;; (or (fboundp 'x-color-defined-p) |
| 4777 | ;; (defalias 'x-color-defined-p | 4770 | ;; (defalias 'x-color-defined-p |
| 4778 | ;; (cond ((fboundp 'color-defined-p) 'color-defined-p) | 4771 | ;; (cond ((fboundp 'color-defined-p) 'color-defined-p) |
| 4779 | ;; ;; XEmacs >= 19.12 | 4772 | ;; ;; XEmacs >= 19.12 |
| 4780 | ;; ((fboundp 'valid-color-name-p) 'valid-color-name-p) | 4773 | ;; ((fboundp 'valid-color-name-p) 'valid-color-name-p) |
| 4781 | ;; ;; XEmacs 19.11 | 4774 | ;; ;; XEmacs 19.11 |
| 4782 | ;; (t 'x-valid-color-name-p)))) | 4775 | ;; (t 'x-valid-color-name-p)))) |
| 4783 | (cperl-force-face font-lock-constant-face | 4776 | (cperl-force-face font-lock-constant-face |
| 4784 | "Face for constant and label names") | 4777 | "Face for constant and label names") |
| 4785 | (cperl-force-face font-lock-variable-name-face | 4778 | (cperl-force-face font-lock-variable-name-face |
| @@ -4846,9 +4839,7 @@ indentation and initial hashes. Behaves usually outside of comment." | |||
| 4846 | (if (boundp 'font-lock-background-mode) | 4839 | (if (boundp 'font-lock-background-mode) |
| 4847 | font-lock-background-mode | 4840 | font-lock-background-mode |
| 4848 | 'light)) | 4841 | 'light)) |
| 4849 | (face-list (and (fboundp 'face-list) (face-list))) | 4842 | (face-list (and (fboundp 'face-list) (face-list)))) |
| 4850 | ;; cperl-is-face | ||
| 4851 | ) | ||
| 4852 | ;;;; (fset 'cperl-is-face | 4843 | ;;;; (fset 'cperl-is-face |
| 4853 | ;;;; (cond ((fboundp 'find-face) | 4844 | ;;;; (cond ((fboundp 'find-face) |
| 4854 | ;;;; (symbol-function 'find-face)) | 4845 | ;;;; (symbol-function 'find-face)) |
| @@ -4862,10 +4853,9 @@ indentation and initial hashes. Behaves usually outside of comment." | |||
| 4862 | 'gray | 4853 | 'gray |
| 4863 | background) | 4854 | background) |
| 4864 | "Background as guessed by CPerl mode") | 4855 | "Background as guessed by CPerl mode") |
| 4865 | (if (and | 4856 | (and (not (cperl-is-face 'font-lock-constant-face)) |
| 4866 | (not (cperl-is-face 'font-lock-constant-face)) | 4857 | (cperl-is-face 'font-lock-reference-face) |
| 4867 | (cperl-is-face 'font-lock-reference-face)) | 4858 | (copy-face 'font-lock-reference-face 'font-lock-constant-face)) |
| 4868 | (copy-face 'font-lock-reference-face 'font-lock-constant-face)) | ||
| 4869 | (if (cperl-is-face 'font-lock-type-face) nil | 4859 | (if (cperl-is-face 'font-lock-type-face) nil |
| 4870 | (copy-face 'default 'font-lock-type-face) | 4860 | (copy-face 'default 'font-lock-type-face) |
| 4871 | (cond | 4861 | (cond |
| @@ -5023,7 +5013,7 @@ Style of printout regulated by the variable `cperl-ps-print-face-properties'." | |||
| 5023 | cperl-continued-statement-offset)) | 5013 | cperl-continued-statement-offset)) |
| 5024 | 5014 | ||
| 5025 | (defconst cperl-style-alist | 5015 | (defconst cperl-style-alist |
| 5026 | '(("CPerl" ; =GNU without extra-newline-before-brace | 5016 | '(("CPerl" ; =GNU without extra-newline-before-brace |
| 5027 | (cperl-indent-level . 2) | 5017 | (cperl-indent-level . 2) |
| 5028 | (cperl-brace-offset . 0) | 5018 | (cperl-brace-offset . 0) |
| 5029 | (cperl-continued-brace-offset . 0) | 5019 | (cperl-continued-brace-offset . 0) |
| @@ -5031,7 +5021,7 @@ Style of printout regulated by the variable `cperl-ps-print-face-properties'." | |||
| 5031 | (cperl-extra-newline-before-brace . nil) | 5021 | (cperl-extra-newline-before-brace . nil) |
| 5032 | (cperl-merge-trailing-else . t) | 5022 | (cperl-merge-trailing-else . t) |
| 5033 | (cperl-continued-statement-offset . 2)) | 5023 | (cperl-continued-statement-offset . 2)) |
| 5034 | ("PerlStyle" ; CPerl with 4 as indent | 5024 | ("PerlStyle" ; CPerl with 4 as indent |
| 5035 | (cperl-indent-level . 4) | 5025 | (cperl-indent-level . 4) |
| 5036 | (cperl-brace-offset . 0) | 5026 | (cperl-brace-offset . 0) |
| 5037 | (cperl-continued-brace-offset . 0) | 5027 | (cperl-continued-brace-offset . 0) |
| @@ -5093,7 +5083,7 @@ data already), may be restored by `cperl-set-style-back'. | |||
| 5093 | Chosing \"Current\" style will not change style, so this may be used for | 5083 | Chosing \"Current\" style will not change style, so this may be used for |
| 5094 | side-effect of memorizing only." | 5084 | side-effect of memorizing only." |
| 5095 | (interactive | 5085 | (interactive |
| 5096 | (let ((list (mapcar (function (lambda (elt) (list (car elt)))) | 5086 | (let ((list (mapcar (function (lambda (elt) (list (car elt)))) |
| 5097 | cperl-style-alist))) | 5087 | cperl-style-alist))) |
| 5098 | (list (completing-read "Enter style: " list nil 'insist)))) | 5088 | (list (completing-read "Enter style: " list nil 'insist)))) |
| 5099 | (or cperl-old-style | 5089 | (or cperl-old-style |
| @@ -5172,11 +5162,11 @@ Customized by setting variables `cperl-shrink-wrap-info-frame', | |||
| 5172 | (interactive | 5162 | (interactive |
| 5173 | (let* ((default (cperl-word-at-point)) | 5163 | (let* ((default (cperl-word-at-point)) |
| 5174 | (read (read-string | 5164 | (read (read-string |
| 5175 | (format "Find doc for Perl function (default %s): " | 5165 | (format "Find doc for Perl function (default %s): " |
| 5176 | default)))) | 5166 | default)))) |
| 5177 | (list (if (equal read "") | 5167 | (list (if (equal read "") |
| 5178 | default | 5168 | default |
| 5179 | read)))) | 5169 | read)))) |
| 5180 | 5170 | ||
| 5181 | (let ((buffer (current-buffer)) | 5171 | (let ((buffer (current-buffer)) |
| 5182 | (cmd-desc (concat "^" (regexp-quote command) "[^a-zA-Z_0-9]")) ; "tr///" | 5172 | (cmd-desc (concat "^" (regexp-quote command) "[^a-zA-Z_0-9]")) ; "tr///" |
| @@ -5235,8 +5225,7 @@ Customized by setting variables `cperl-shrink-wrap-info-frame', | |||
| 5235 | ;; Non-functioning under OS/2: | 5225 | ;; Non-functioning under OS/2: |
| 5236 | (if (eq char-height 1) (setq char-height 18)) | 5226 | (if (eq char-height 1) (setq char-height 18)) |
| 5237 | ;; Title, menubar, + 2 for slack | 5227 | ;; Title, menubar, + 2 for slack |
| 5238 | (- (/ (x-display-pixel-height) char-height) 4) | 5228 | (- (/ (x-display-pixel-height) char-height) 4))) |
| 5239 | )) | ||
| 5240 | (if (> height max-height) (setq height max-height)) | 5229 | (if (> height max-height) (setq height max-height)) |
| 5241 | ;;(message "was %s doing %s" iniheight height) | 5230 | ;;(message "was %s doing %s" iniheight height) |
| 5242 | (if not-loner | 5231 | (if not-loner |
| @@ -5343,7 +5332,7 @@ Will not move the position at the start to the left." | |||
| 5343 | (setq e (point)) | 5332 | (setq e (point)) |
| 5344 | (skip-chars-backward " \t") | 5333 | (skip-chars-backward " \t") |
| 5345 | (delete-region (point) e) | 5334 | (delete-region (point) e) |
| 5346 | (indent-to-column col); (make-string (- col (current-column)) ?\ )) | 5335 | (indent-to-column col) ;(make-string (- col (current-column)) ?\ )) |
| 5347 | (beginning-of-line 2) | 5336 | (beginning-of-line 2) |
| 5348 | (and (< (point) end) | 5337 | (and (< (point) end) |
| 5349 | (re-search-forward search end t) | 5338 | (re-search-forward search end t) |
| @@ -5458,7 +5447,7 @@ See `cperl-lazy-help-time' too." | |||
| 5458 | (or noninteractive | 5447 | (or noninteractive |
| 5459 | (imenu-progress-message prev-pos)) | 5448 | (imenu-progress-message prev-pos)) |
| 5460 | (cond | 5449 | (cond |
| 5461 | ((match-beginning 2) ; SECTION | 5450 | ((match-beginning 2) ; SECTION |
| 5462 | (setq package (buffer-substring (match-beginning 2) (match-end 2))) | 5451 | (setq package (buffer-substring (match-beginning 2) (match-end 2))) |
| 5463 | (goto-char (match-beginning 0)) | 5452 | (goto-char (match-beginning 0)) |
| 5464 | (skip-chars-forward " \t") | 5453 | (skip-chars-forward " \t") |
| @@ -5491,11 +5480,11 @@ See `cperl-lazy-help-time' too." | |||
| 5491 | (defvar cperl-unreadable-ok nil) | 5480 | (defvar cperl-unreadable-ok nil) |
| 5492 | 5481 | ||
| 5493 | (defun cperl-find-tags (ifile xs topdir) | 5482 | (defun cperl-find-tags (ifile xs topdir) |
| 5494 | (let (ind (b (get-buffer cperl-tmp-buffer)) lst elt pos ret rel | 5483 | (let ((b (get-buffer cperl-tmp-buffer)) ind lst elt pos ret rel |
| 5495 | (cperl-pod-here-fontify nil) f file) | 5484 | (cperl-pod-here-fontify nil) f file) |
| 5496 | (save-excursion | 5485 | (save-excursion |
| 5497 | (if b (set-buffer b) | 5486 | (if b (set-buffer b) |
| 5498 | (cperl-setup-tmp-buf)) | 5487 | (cperl-setup-tmp-buf)) |
| 5499 | (erase-buffer) | 5488 | (erase-buffer) |
| 5500 | (condition-case err | 5489 | (condition-case err |
| 5501 | (setq file (car (insert-file-contents ifile))) | 5490 | (setq file (car (insert-file-contents ifile))) |
| @@ -5506,72 +5495,72 @@ See `cperl-lazy-help-time' too." | |||
| 5506 | (error "Aborting: unreadable file %s" ifile))))) | 5495 | (error "Aborting: unreadable file %s" ifile))))) |
| 5507 | (if (not file) | 5496 | (if (not file) |
| 5508 | (message "Unreadable file %s" ifile) | 5497 | (message "Unreadable file %s" ifile) |
| 5509 | (message "Scanning file %s ..." file) | 5498 | (message "Scanning file %s ..." file) |
| 5510 | (if (and cperl-use-syntax-table-text-property-for-tags | 5499 | (if (and cperl-use-syntax-table-text-property-for-tags |
| 5511 | (not xs)) | 5500 | (not xs)) |
| 5512 | (condition-case err ; after __END__ may have garbage | 5501 | (condition-case err ; after __END__ may have garbage |
| 5513 | (cperl-find-pods-heres nil nil noninteractive) | 5502 | (cperl-find-pods-heres nil nil noninteractive) |
| 5514 | (error (message "While scanning for syntax: %s" err)))) | 5503 | (error (message "While scanning for syntax: %s" err)))) |
| 5515 | (if xs | 5504 | (if xs |
| 5516 | (setq lst (cperl-xsub-scan)) | 5505 | (setq lst (cperl-xsub-scan)) |
| 5517 | (setq ind (cperl-imenu--create-perl-index)) | 5506 | (setq ind (cperl-imenu--create-perl-index)) |
| 5518 | (setq lst (cdr (assoc "+Unsorted List+..." ind)))) | 5507 | (setq lst (cdr (assoc "+Unsorted List+..." ind)))) |
| 5519 | (setq lst | 5508 | (setq lst |
| 5520 | (mapcar | 5509 | (mapcar |
| 5521 | (function | 5510 | (function |
| 5522 | (lambda (elt) | 5511 | (lambda (elt) |
| 5523 | (cond ((string-match "^[_a-zA-Z]" (car elt)) | 5512 | (cond ((string-match "^[_a-zA-Z]" (car elt)) |
| 5524 | (goto-char (cdr elt)) | 5513 | (goto-char (cdr elt)) |
| 5525 | (beginning-of-line) ; pos should be of the start of the line | 5514 | (beginning-of-line) ; pos should be of the start of the line |
| 5526 | (list (car elt) | 5515 | (list (car elt) |
| 5527 | (point) | 5516 | (point) |
| 5528 | (1+ (count-lines 1 (point))) ; 1+ since at beg-o-l | 5517 | (1+ (count-lines 1 (point))) ; 1+ since at beg-o-l |
| 5529 | (buffer-substring (progn | 5518 | (buffer-substring (progn |
| 5530 | (goto-char (cdr elt)) | 5519 | (goto-char (cdr elt)) |
| 5531 | ;; After name now... | 5520 | ;; After name now... |
| 5532 | (or (eolp) (forward-char 1)) | 5521 | (or (eolp) (forward-char 1)) |
| 5533 | (point)) | 5522 | (point)) |
| 5534 | (progn | 5523 | (progn |
| 5535 | (beginning-of-line) | 5524 | (beginning-of-line) |
| 5536 | (point)))))))) | 5525 | (point)))))))) |
| 5537 | lst)) | 5526 | lst)) |
| 5538 | (erase-buffer) | 5527 | (erase-buffer) |
| 5539 | (while lst | 5528 | (while lst |
| 5540 | (setq elt (car lst) lst (cdr lst)) | 5529 | (setq elt (car lst) lst (cdr lst)) |
| 5541 | (if elt | 5530 | (if elt |
| 5542 | (progn | 5531 | (progn |
| 5543 | (insert (elt elt 3) | 5532 | (insert (elt elt 3) |
| 5544 | 127 | 5533 | 127 |
| 5545 | (if (string-match "^package " (car elt)) | 5534 | (if (string-match "^package " (car elt)) |
| 5546 | (substring (car elt) 8) | 5535 | (substring (car elt) 8) |
| 5547 | (car elt) ) | 5536 | (car elt) ) |
| 5548 | 1 | 5537 | 1 |
| 5549 | (number-to-string (elt elt 2)) ; Line | 5538 | (number-to-string (elt elt 2)) ; Line |
| 5550 | "," | 5539 | "," |
| 5551 | (number-to-string (1- (elt elt 1))) ; Char pos 0-based | 5540 | (number-to-string (1- (elt elt 1))) ; Char pos 0-based |
| 5552 | "\n") | 5541 | "\n") |
| 5553 | (if (and (string-match "^[_a-zA-Z]+::" (car elt)) | 5542 | (if (and (string-match "^[_a-zA-Z]+::" (car elt)) |
| 5554 | (string-match "^sub[ \t]+\\([_a-zA-Z]+\\)[^:_a-zA-Z]" | 5543 | (string-match "^sub[ \t]+\\([_a-zA-Z]+\\)[^:_a-zA-Z]" |
| 5555 | (elt elt 3))) | 5544 | (elt elt 3))) |
| 5556 | ;; Need to insert the name without package as well | 5545 | ;; Need to insert the name without package as well |
| 5557 | (setq lst (cons (cons (substring (elt elt 3) | 5546 | (setq lst (cons (cons (substring (elt elt 3) |
| 5558 | (match-beginning 1) | 5547 | (match-beginning 1) |
| 5559 | (match-end 1)) | 5548 | (match-end 1)) |
| 5560 | (cdr elt)) | 5549 | (cdr elt)) |
| 5561 | lst)))))) | 5550 | lst)))))) |
| 5562 | (setq pos (point)) | 5551 | (setq pos (point)) |
| 5563 | (goto-char 1) | 5552 | (goto-char 1) |
| 5564 | (setq rel file) | 5553 | (setq rel file) |
| 5565 | ;; On case-preserving filesystems (EMX on OS/2) case might be encoded in properties | 5554 | ;; On case-preserving filesystems (EMX on OS/2) case might be encoded in properties |
| 5566 | (set-text-properties 0 (length rel) nil rel) | 5555 | (set-text-properties 0 (length rel) nil rel) |
| 5567 | (and (equal topdir (substring rel 0 (length topdir))) | 5556 | (and (equal topdir (substring rel 0 (length topdir))) |
| 5568 | (setq rel (substring file (length topdir)))) | 5557 | (setq rel (substring file (length topdir)))) |
| 5569 | (insert "\f\n" rel "," (number-to-string (1- pos)) "\n") | 5558 | (insert "\f\n" rel "," (number-to-string (1- pos)) "\n") |
| 5570 | (setq ret (buffer-substring 1 (point-max))) | 5559 | (setq ret (buffer-substring 1 (point-max))) |
| 5571 | (erase-buffer) | 5560 | (erase-buffer) |
| 5572 | (or noninteractive | 5561 | (or noninteractive |
| 5573 | (message "Scanning file %s finished" file)) | 5562 | (message "Scanning file %s finished" file)) |
| 5574 | ret)))) | 5563 | ret)))) |
| 5575 | 5564 | ||
| 5576 | (defun cperl-add-tags-recurse-noxs () | 5565 | (defun cperl-add-tags-recurse-noxs () |
| 5577 | "Add to TAGS data for Perl and XSUB files in the current directory and kids. | 5566 | "Add to TAGS data for Perl and XSUB files in the current directory and kids. |
| @@ -5606,7 +5595,7 @@ Use as | |||
| 5606 | ((file-exists-p tags-file-name) | 5595 | ((file-exists-p tags-file-name) |
| 5607 | (if cperl-xemacs-p | 5596 | (if cperl-xemacs-p |
| 5608 | (visit-tags-table-buffer) | 5597 | (visit-tags-table-buffer) |
| 5609 | (visit-tags-table-buffer tags-file-name))) | 5598 | (visit-tags-table-buffer tags-file-name))) |
| 5610 | (t (set-buffer (find-file-noselect tags-file-name)))) | 5599 | (t (set-buffer (find-file-noselect tags-file-name)))) |
| 5611 | (cond | 5600 | (cond |
| 5612 | (dir | 5601 | (dir |
| @@ -5624,46 +5613,46 @@ Use as | |||
| 5624 | (if (y-or-n-p | 5613 | (if (y-or-n-p |
| 5625 | (format "Directory %s unreadable. Continue? " file)) | 5614 | (format "Directory %s unreadable. Continue? " file)) |
| 5626 | (setq cperl-unreadable-ok t | 5615 | (setq cperl-unreadable-ok t |
| 5627 | tm nil) ; Return empty list | 5616 | tm nil) ; Return empty list |
| 5628 | (error "Aborting: unreadable directory %s" file))))))) | 5617 | (error "Aborting: unreadable directory %s" file))))))) |
| 5629 | (mapcar (function (lambda (file) | 5618 | (mapcar (function |
| 5630 | (cond | 5619 | (lambda (file) |
| 5631 | ((string-match cperl-noscan-files-regexp file) | 5620 | (cond |
| 5632 | nil) | 5621 | ((string-match cperl-noscan-files-regexp file) |
| 5633 | ((not (file-directory-p file)) | 5622 | nil) |
| 5634 | (if (string-match cperl-scan-files-regexp file) | 5623 | ((not (file-directory-p file)) |
| 5635 | (cperl-write-tags file erase recurse nil t noxs topdir))) | 5624 | (if (string-match cperl-scan-files-regexp file) |
| 5636 | ((not recurse) nil) | 5625 | (cperl-write-tags file erase recurse nil t noxs topdir))) |
| 5637 | (t (cperl-write-tags file erase recurse t t noxs topdir))))) | 5626 | ((not recurse) nil) |
| 5638 | files)) | 5627 | (t (cperl-write-tags file erase recurse t t noxs topdir))))) |
| 5639 | ) | 5628 | files))) |
| 5640 | (t | 5629 | (t |
| 5641 | (setq xs (string-match "\\.xs$" file)) | 5630 | (setq xs (string-match "\\.xs$" file)) |
| 5642 | (if (not (and xs noxs)) | 5631 | (if (not (and xs noxs)) |
| 5643 | (progn | 5632 | (progn |
| 5644 | (cond ((eq erase 'ignore) (goto-char (point-max))) | 5633 | (cond ((eq erase 'ignore) (goto-char (point-max))) |
| 5645 | (erase (erase-buffer)) | 5634 | (erase (erase-buffer)) |
| 5646 | (t | 5635 | (t |
| 5647 | (goto-char 1) | 5636 | (goto-char 1) |
| 5648 | (setq rel file) | 5637 | (setq rel file) |
| 5649 | ;; On case-preserving filesystems (EMX on OS/2) case might be encoded in properties | 5638 | ;; On case-preserving filesystems (EMX on OS/2) case might be encoded in properties |
| 5650 | (set-text-properties 0 (length rel) nil rel) | 5639 | (set-text-properties 0 (length rel) nil rel) |
| 5651 | (and (equal topdir (substring rel 0 (length topdir))) | 5640 | (and (equal topdir (substring rel 0 (length topdir))) |
| 5652 | (setq rel (substring file (length topdir)))) | 5641 | (setq rel (substring file (length topdir)))) |
| 5653 | (if (search-forward (concat "\f\n" rel ",") nil t) | 5642 | (if (search-forward (concat "\f\n" rel ",") nil t) |
| 5654 | (progn | 5643 | (progn |
| 5655 | (search-backward "\f\n") | 5644 | (search-backward "\f\n") |
| 5656 | (delete-region (point) | 5645 | (delete-region (point) |
| 5657 | (save-excursion | 5646 | (save-excursion |
| 5658 | (forward-char 1) | 5647 | (forward-char 1) |
| 5659 | (if (search-forward "\f\n" | 5648 | (if (search-forward "\f\n" |
| 5660 | nil 'toend) | 5649 | nil 'toend) |
| 5661 | (- (point) 2) | 5650 | (- (point) 2) |
| 5662 | (point-max))))) | 5651 | (point-max))))) |
| 5663 | (goto-char (point-max))))) | 5652 | (goto-char (point-max))))) |
| 5664 | (insert (cperl-find-tags file xs topdir)))))) | 5653 | (insert (cperl-find-tags file xs topdir)))))) |
| 5665 | (if inbuffer nil ; Delegate to the caller | 5654 | (if inbuffer nil ; Delegate to the caller |
| 5666 | (save-buffer 0) ; No backup | 5655 | (save-buffer 0) ; No backup |
| 5667 | (if (fboundp 'initialize-new-tags-table) ; Do we need something special in XEmacs? | 5656 | (if (fboundp 'initialize-new-tags-table) ; Do we need something special in XEmacs? |
| 5668 | (initialize-new-tags-table)))))) | 5657 | (initialize-new-tags-table)))))) |
| 5669 | 5658 | ||
| @@ -5733,11 +5722,11 @@ One may build such TAGS files from CPerl mode menu." | |||
| 5733 | (require 'etags) | 5722 | (require 'etags) |
| 5734 | (require 'imenu) | 5723 | (require 'imenu) |
| 5735 | (if (or update (null (nth 2 cperl-hierarchy))) | 5724 | (if (or update (null (nth 2 cperl-hierarchy))) |
| 5736 | (let (pack name cons1 to l1 l2 l3 l4 b | 5725 | (let ((remover (function (lambda (elt) ; (name (file1...) (file2..)) |
| 5737 | (remover (function (lambda (elt) ; (name (file1...) (file2..)) | 5726 | (or (nthcdr 2 elt) |
| 5738 | (or (nthcdr 2 elt) | 5727 | ;; Only in one file |
| 5739 | ;; Only in one file | 5728 | (setcdr elt (cdr (nth 1 elt))))))) |
| 5740 | (setcdr elt (cdr (nth 1 elt)))))))) | 5729 | pack name cons1 to l1 l2 l3 l4 b) |
| 5741 | ;; (setq cperl-hierarchy '(() () ())) ; Would write into '() later! | 5730 | ;; (setq cperl-hierarchy '(() () ())) ; Would write into '() later! |
| 5742 | (setq cperl-hierarchy (list l1 l2 l3)) | 5731 | (setq cperl-hierarchy (list l1 l2 l3)) |
| 5743 | (if cperl-xemacs-p ; Not checked | 5732 | (if cperl-xemacs-p ; Not checked |
| @@ -5772,7 +5761,10 @@ One may build such TAGS files from CPerl mode menu." | |||
| 5772 | (error "No items found")) | 5761 | (error "No items found")) |
| 5773 | (setq update | 5762 | (setq update |
| 5774 | ;;; (imenu-choose-buffer-index "Packages: " (nth 2 cperl-hierarchy)) | 5763 | ;;; (imenu-choose-buffer-index "Packages: " (nth 2 cperl-hierarchy)) |
| 5775 | (if window-system | 5764 | (if (if (fboundp 'display-popup-menus-p) |
| 5765 | (let ((f 'display-popup-menus-p)) | ||
| 5766 | (funcall f)) | ||
| 5767 | window-system) | ||
| 5776 | (x-popup-menu t (nth 2 cperl-hierarchy)) | 5768 | (x-popup-menu t (nth 2 cperl-hierarchy)) |
| 5777 | (require 'tmm) | 5769 | (require 'tmm) |
| 5778 | (tmm-prompt (nth 2 cperl-hierarchy)))) | 5770 | (tmm-prompt (nth 2 cperl-hierarchy)))) |
| @@ -5853,8 +5845,7 @@ One may build such TAGS files from CPerl mode menu." | |||
| 5853 | (if (default-value 'imenu-sort-function) | 5845 | (if (default-value 'imenu-sort-function) |
| 5854 | (nreverse | 5846 | (nreverse |
| 5855 | (sort root-packages (default-value 'imenu-sort-function))) | 5847 | (sort root-packages (default-value 'imenu-sort-function))) |
| 5856 | root-packages)) | 5848 | root-packages)))) |
| 5857 | )) | ||
| 5858 | 5849 | ||
| 5859 | ;;;(x-popup-menu t | 5850 | ;;;(x-popup-menu t |
| 5860 | ;;; '(keymap "Name1" | 5851 | ;;; '(keymap "Name1" |
| @@ -5901,14 +5892,14 @@ One may build such TAGS files from CPerl mode menu." | |||
| 5901 | 5892 | ||
| 5902 | (defvar cperl-bad-style-regexp | 5893 | (defvar cperl-bad-style-regexp |
| 5903 | (mapconcat 'identity | 5894 | (mapconcat 'identity |
| 5904 | '("[^-\n\t <>=+!.&|(*/'`\"#^][-=+<>!|&^]" ; char sign | 5895 | '("[^-\n\t <>=+!.&|(*/'`\"#^][-=+<>!|&^]" ; char sign |
| 5905 | "[-<>=+^&|]+[^- \t\n=+<>~]" ; sign+ char | 5896 | "[-<>=+^&|]+[^- \t\n=+<>~]") ; sign+ char |
| 5906 | ) | 5897 | "\\|") |
| 5907 | "\\|") | ||
| 5908 | "Finds places such that insertion of a whitespace may help a lot.") | 5898 | "Finds places such that insertion of a whitespace may help a lot.") |
| 5909 | 5899 | ||
| 5910 | (defvar cperl-not-bad-style-regexp | 5900 | (defvar cperl-not-bad-style-regexp |
| 5911 | (mapconcat 'identity | 5901 | (mapconcat |
| 5902 | 'identity | ||
| 5912 | '("[^-\t <>=+]\\(--\\|\\+\\+\\)" ; var-- var++ | 5903 | '("[^-\t <>=+]\\(--\\|\\+\\+\\)" ; var-- var++ |
| 5913 | "[a-zA-Z0-9_][|&][a-zA-Z0-9_$]" ; abc|def abc&def are often used. | 5904 | "[a-zA-Z0-9_][|&][a-zA-Z0-9_$]" ; abc|def abc&def are often used. |
| 5914 | "&[(a-zA-Z0-9_$]" ; &subroutine &(var->field) | 5905 | "&[(a-zA-Z0-9_$]" ; &subroutine &(var->field) |
| @@ -5927,7 +5918,7 @@ One may build such TAGS files from CPerl mode menu." | |||
| 5927 | "||" | 5918 | "||" |
| 5928 | "&&" | 5919 | "&&" |
| 5929 | "[CBIXSLFZ]<\\(\\sw\\|\\s \\|\\s_\\|[\n]\\)*>" ; C<code like text> | 5920 | "[CBIXSLFZ]<\\(\\sw\\|\\s \\|\\s_\\|[\n]\\)*>" ; C<code like text> |
| 5930 | "-[a-zA-Z_0-9]+[ \t]*=>" ; -option => value | 5921 | "-[a-zA-Z_0-9]+[ \t]*=>" ; -option => value |
| 5931 | ;; Unaddressed trouble spots: = -abc, f(56, -abc) --- specialcased below | 5922 | ;; Unaddressed trouble spots: = -abc, f(56, -abc) --- specialcased below |
| 5932 | ;;"[*/+-|&<.]+=" | 5923 | ;;"[*/+-|&<.]+=" |
| 5933 | ) | 5924 | ) |
| @@ -5946,7 +5937,7 @@ Currently it is tuned to C and Perl syntax." | |||
| 5946 | (setq last-nonmenu-event 13) ; To disable popup | 5937 | (setq last-nonmenu-event 13) ; To disable popup |
| 5947 | (beginning-of-buffer) | 5938 | (beginning-of-buffer) |
| 5948 | (map-y-or-n-p "Insert space here? " | 5939 | (map-y-or-n-p "Insert space here? " |
| 5949 | (function (lambda (arg) (insert " "))) | 5940 | (lambda (arg) (insert " ")) |
| 5950 | 'cperl-next-bad-style | 5941 | 'cperl-next-bad-style |
| 5951 | '("location" "locations" "insert a space into") | 5942 | '("location" "locations" "insert a space into") |
| 5952 | '((?\C-r (lambda (arg) | 5943 | '((?\C-r (lambda (arg) |
| @@ -5999,22 +5990,20 @@ Currently it is tuned to C and Perl syntax." | |||
| 5999 | ;;(concat "\\(" | 5990 | ;;(concat "\\(" |
| 6000 | (mapconcat | 5991 | (mapconcat |
| 6001 | 'identity | 5992 | 'identity |
| 6002 | '("[$@%*&][0-9a-zA-Z_:]+\\([ \t]*[[{]\\)?" ; Usual variable | 5993 | '("[$@%*&][0-9a-zA-Z_:]+\\([ \t]*[[{]\\)?" ; Usual variable |
| 6003 | "[$@]\\^[a-zA-Z]" ; Special variable | 5994 | "[$@]\\^[a-zA-Z]" ; Special variable |
| 6004 | "[$@][^ \n\t]" ; Special variable | 5995 | "[$@][^ \n\t]" ; Special variable |
| 6005 | "-[a-zA-Z]" ; File test | 5996 | "-[a-zA-Z]" ; File test |
| 6006 | "\\\\[a-zA-Z0]" ; Special chars | 5997 | "\\\\[a-zA-Z0]" ; Special chars |
| 6007 | "^=[a-z][a-zA-Z0-9_]*" ; Pod sections | 5998 | "^=[a-z][a-zA-Z0-9_]*" ; POD sections |
| 6008 | "[-!&*+,-./<=>?\\\\^|~]+" ; Operator | 5999 | "[-!&*+,-./<=>?\\\\^|~]+" ; Operator |
| 6009 | "[a-zA-Z_0-9:]+" ; symbol or number | 6000 | "[a-zA-Z_0-9:]+" ; symbol or number |
| 6010 | "x=" | 6001 | "x=" |
| 6011 | "#!" | 6002 | "#!") |
| 6012 | ) | ||
| 6013 | ;;"\\)\\|\\(" | 6003 | ;;"\\)\\|\\(" |
| 6014 | "\\|" | 6004 | "\\|") |
| 6015 | ) | 6005 | ;;"\\)" |
| 6016 | ;;"\\)" | 6006 | ;;) |
| 6017 | ;;) | ||
| 6018 | "Matches places in the buffer we can find help for.") | 6007 | "Matches places in the buffer we can find help for.") |
| 6019 | 6008 | ||
| 6020 | (defvar cperl-message-on-help-error t) | 6009 | (defvar cperl-message-on-help-error t) |
| @@ -6102,22 +6091,22 @@ than a line. Your contribution to update/shorten it is appreciated." | |||
| 6102 | (let ((enable-recursive-minibuffers t) | 6091 | (let ((enable-recursive-minibuffers t) |
| 6103 | args-file regexp) | 6092 | args-file regexp) |
| 6104 | (cond | 6093 | (cond |
| 6105 | ((string-match "^[&*][a-zA-Z_]" val) | 6094 | ((string-match "^[&*][a-zA-Z_]" val) |
| 6106 | (setq val (concat (substring val 0 1) "NAME"))) | 6095 | (setq val (concat (substring val 0 1) "NAME"))) |
| 6107 | ((string-match "^[$@]\\([a-zA-Z_:0-9]+\\)[ \t]*\\[" val) | 6096 | ((string-match "^[$@]\\([a-zA-Z_:0-9]+\\)[ \t]*\\[" val) |
| 6108 | (setq val (concat "@" (substring val 1 (match-end 1))))) | 6097 | (setq val (concat "@" (substring val 1 (match-end 1))))) |
| 6109 | ((string-match "^[$@]\\([a-zA-Z_:0-9]+\\)[ \t]*{" val) | 6098 | ((string-match "^[$@]\\([a-zA-Z_:0-9]+\\)[ \t]*{" val) |
| 6110 | (setq val (concat "%" (substring val 1 (match-end 1))))) | 6099 | (setq val (concat "%" (substring val 1 (match-end 1))))) |
| 6111 | ((and (string= val "x") (string-match "^x=" val)) | 6100 | ((and (string= val "x") (string-match "^x=" val)) |
| 6112 | (setq val "x=")) | 6101 | (setq val "x=")) |
| 6113 | ((string-match "^\\$[\C-a-\C-z]" val) | 6102 | ((string-match "^\\$[\C-a-\C-z]" val) |
| 6114 | (setq val (concat "$^" (char-to-string (+ ?A -1 (aref val 1)))))) | 6103 | (setq val (concat "$^" (char-to-string (+ ?A -1 (aref val 1)))))) |
| 6115 | ((string-match "^CORE::" val) | 6104 | ((string-match "^CORE::" val) |
| 6116 | (setq val "CORE::")) | 6105 | (setq val "CORE::")) |
| 6117 | ((string-match "^SUPER::" val) | 6106 | ((string-match "^SUPER::" val) |
| 6118 | (setq val "SUPER::")) | 6107 | (setq val "SUPER::")) |
| 6119 | ((and (string= "<" val) (string-match "^<\\$?[a-zA-Z0-9_:]+>" val)) | 6108 | ((and (string= "<" val) (string-match "^<\\$?[a-zA-Z0-9_:]+>" val)) |
| 6120 | (setq val "<NAME>"))) | 6109 | (setq val "<NAME>"))) |
| 6121 | (setq regexp (concat "^" | 6110 | (setq regexp (concat "^" |
| 6122 | "\\([^a-zA-Z0-9_:]+[ \t]+\\)?" | 6111 | "\\([^a-zA-Z0-9_:]+[ \t]+\\)?" |
| 6123 | (regexp-quote val) | 6112 | (regexp-quote val) |
| @@ -6139,7 +6128,7 @@ than a line. Your contribution to update/shorten it is appreciated." | |||
| 6139 | (if cperl-message-on-help-error | 6128 | (if cperl-message-on-help-error |
| 6140 | (message "No definition for %s" val))))))) | 6129 | (message "No definition for %s" val))))))) |
| 6141 | 6130 | ||
| 6142 | (defvar cperl-short-docs "Ignore my value" | 6131 | (defvar cperl-short-docs 'please-ignore-this-line |
| 6143 | ;; Perl4 version was written by Johan Vromans (jvromans@squirrel.nl) | 6132 | ;; Perl4 version was written by Johan Vromans (jvromans@squirrel.nl) |
| 6144 | "# based on '@(#)@ perl-descr.el 1.9 - describe-perl-symbol' [Perl 5] | 6133 | "# based on '@(#)@ perl-descr.el 1.9 - describe-perl-symbol' [Perl 5] |
| 6145 | ! ... Logical negation. | 6134 | ! ... Logical negation. |
| @@ -6525,7 +6514,7 @@ chomp [LIST] Strips $/ off LIST/$_. Returns count. Special if $/ eq ''! | |||
| 6525 | chr Converts a number to char with the same ordinal. | 6514 | chr Converts a number to char with the same ordinal. |
| 6526 | else Part of if/unless {BLOCK} elsif {BLOCK} else {BLOCK}. | 6515 | else Part of if/unless {BLOCK} elsif {BLOCK} else {BLOCK}. |
| 6527 | elsif Part of if/unless {BLOCK} elsif {BLOCK} else {BLOCK}. | 6516 | elsif Part of if/unless {BLOCK} elsif {BLOCK} else {BLOCK}. |
| 6528 | exists $HASH{KEY} True if the key exists. | 6517 | exists $HASH{KEY} True if the key exists. |
| 6529 | format [NAME] = Start of output format. Ended by a single dot (.) on a line. | 6518 | format [NAME] = Start of output format. Ended by a single dot (.) on a line. |
| 6530 | formline PICTURE, LIST Backdoor into \"format\" processing. | 6519 | formline PICTURE, LIST Backdoor into \"format\" processing. |
| 6531 | glob EXPR Synonym of <EXPR>. | 6520 | glob EXPR Synonym of <EXPR>. |
| @@ -6603,7 +6592,7 @@ prototype \&SUB Returns prototype of the function given a reference. | |||
| 6603 | (goto-char e) | 6592 | (goto-char e) |
| 6604 | (beginning-of-line) | 6593 | (beginning-of-line) |
| 6605 | (if (re-search-forward "[^ \t]" e t) | 6594 | (if (re-search-forward "[^ \t]" e t) |
| 6606 | (progn ; Something before the ending delimiter | 6595 | (progn ; Something before the ending delimiter |
| 6607 | (goto-char e) | 6596 | (goto-char e) |
| 6608 | (delete-horizontal-space) | 6597 | (delete-horizontal-space) |
| 6609 | (insert "\n") | 6598 | (insert "\n") |
| @@ -6633,8 +6622,7 @@ prototype \&SUB Returns prototype of the function given a reference. | |||
| 6633 | "\\|" ; Grouping | 6622 | "\\|" ; Grouping |
| 6634 | "\\((\\(\\?\\)?\\)" ; 7 8 | 6623 | "\\((\\(\\?\\)?\\)" ; 7 8 |
| 6635 | "\\|" ; | | 6624 | "\\|" ; | |
| 6636 | "\\(|\\)" ; 9 | 6625 | "\\(|\\)"))) ; 9 |
| 6637 | ))) | ||
| 6638 | (goto-char (match-end 0)) | 6626 | (goto-char (match-end 0)) |
| 6639 | (setq spaces t) | 6627 | (setq spaces t) |
| 6640 | (cond ((match-beginning 1) ; Alphanum word + junk | 6628 | (cond ((match-beginning 1) ; Alphanum word + junk |
| @@ -6744,20 +6732,19 @@ prototype \&SUB Returns prototype of the function given a reference. | |||
| 6744 | (not spaces) | 6732 | (not spaces) |
| 6745 | (insert " ")) | 6733 | (insert " ")) |
| 6746 | (skip-chars-forward " \t")) | 6734 | (skip-chars-forward " \t")) |
| 6747 | (or (looking-at "[#\n]") | 6735 | (or (looking-at "[#\n]") |
| 6748 | (error "Unknown code `%s' in a regexp" | 6736 | (error "Unknown code `%s' in a regexp" |
| 6749 | (buffer-substring (point) (1+ (point))))) | 6737 | (buffer-substring (point) (1+ (point))))) |
| 6750 | (and inline (end-of-line 2))) | 6738 | (and inline (end-of-line 2))) |
| 6751 | ;; Special-case the last line of group | 6739 | ;; Special-case the last line of group |
| 6752 | (if (and (>= (point) (marker-position e)) | 6740 | (if (and (>= (point) (marker-position e)) |
| 6753 | (/= (current-indentation) c)) | 6741 | (/= (current-indentation) c)) |
| 6754 | (progn | 6742 | (progn |
| 6755 | (beginning-of-line) | 6743 | (beginning-of-line) |
| 6756 | (setq s (point)) | 6744 | (setq s (point)) |
| 6757 | (skip-chars-forward " \t") | 6745 | (skip-chars-forward " \t") |
| 6758 | (delete-region s (point)) | 6746 | (delete-region s (point)) |
| 6759 | (indent-to-column c))) | 6747 | (indent-to-column c))))) |
| 6760 | )) | ||
| 6761 | 6748 | ||
| 6762 | (defun cperl-make-regexp-x () | 6749 | (defun cperl-make-regexp-x () |
| 6763 | ;; Returns position of the start | 6750 | ;; Returns position of the start |
| @@ -6770,7 +6757,7 @@ prototype \&SUB Returns prototype of the function given a reference. | |||
| 6770 | nil ; good already | 6757 | nil ; good already |
| 6771 | (if (looking-at "\\([smy]\\|qr\\)\\s|") | 6758 | (if (looking-at "\\([smy]\\|qr\\)\\s|") |
| 6772 | (forward-char 1) | 6759 | (forward-char 1) |
| 6773 | (re-search-backward "\\s|"))) ; Assume it is scanned already. | 6760 | (re-search-backward "\\s|"))) ; Assume it is scanned already. |
| 6774 | ;;(forward-char 1) | 6761 | ;;(forward-char 1) |
| 6775 | (let ((b (point)) (e (make-marker)) have-x delim (c (current-column)) | 6762 | (let ((b (point)) (e (make-marker)) have-x delim (c (current-column)) |
| 6776 | (sub-p (eq (preceding-char) ?s)) s) | 6763 | (sub-p (eq (preceding-char) ?s)) s) |
| @@ -6825,23 +6812,23 @@ We suppose that the regexp is scanned already." | |||
| 6825 | We suppose that the regexp is scanned already." | 6812 | We suppose that the regexp is scanned already." |
| 6826 | (interactive) | 6813 | (interactive) |
| 6827 | ;; (save-excursion ; Can't, breaks `cperl-contract-levels' | 6814 | ;; (save-excursion ; Can't, breaks `cperl-contract-levels' |
| 6828 | (cperl-regext-to-level-start) | 6815 | (cperl-regext-to-level-start) |
| 6829 | (let ((b (point)) (e (make-marker)) s c) | 6816 | (let ((b (point)) (e (make-marker)) s c) |
| 6830 | (forward-sexp 1) | 6817 | (forward-sexp 1) |
| 6831 | (set-marker e (1- (point))) | 6818 | (set-marker e (1- (point))) |
| 6832 | (goto-char b) | 6819 | (goto-char b) |
| 6833 | (while (re-search-forward "\\(#\\)\\|\n" e 'to-end) | 6820 | (while (re-search-forward "\\(#\\)\\|\n" e 'to-end) |
| 6834 | (cond | 6821 | (cond |
| 6835 | ((match-beginning 1) ; #-comment | 6822 | ((match-beginning 1) ; #-comment |
| 6836 | (or c (setq c (current-indentation))) | 6823 | (or c (setq c (current-indentation))) |
| 6837 | (beginning-of-line 2) ; Skip | 6824 | (beginning-of-line 2) ; Skip |
| 6838 | (setq s (point)) | 6825 | (setq s (point)) |
| 6839 | (skip-chars-forward " \t") | 6826 | (skip-chars-forward " \t") |
| 6840 | (delete-region s (point)) | 6827 | (delete-region s (point)) |
| 6841 | (indent-to-column c)) | 6828 | (indent-to-column c)) |
| 6842 | (t | 6829 | (t |
| 6843 | (delete-char -1) | 6830 | (delete-char -1) |
| 6844 | (just-one-space)))))) | 6831 | (just-one-space)))))) |
| 6845 | 6832 | ||
| 6846 | (defun cperl-contract-levels () | 6833 | (defun cperl-contract-levels () |
| 6847 | "Find an enclosing group in regexp and contract all the kids. | 6834 | "Find an enclosing group in regexp and contract all the kids. |
| @@ -6881,7 +6868,7 @@ We suppose that the regexp is scanned already." | |||
| 6881 | "Change `if (A) {B}' into `B if A;' etc if possible." | 6868 | "Change `if (A) {B}' into `B if A;' etc if possible." |
| 6882 | (interactive) | 6869 | (interactive) |
| 6883 | (or (looking-at "\\<") | 6870 | (or (looking-at "\\<") |
| 6884 | (forward-sexp -1)) | 6871 | (forward-sexp -1)) |
| 6885 | (if (looking-at "\\<\\(if\\|unless\\|while\\|until\\|for\\|foreach\\)\\>") | 6872 | (if (looking-at "\\<\\(if\\|unless\\|while\\|until\\|for\\|foreach\\)\\>") |
| 6886 | (let ((pos1 (point)) | 6873 | (let ((pos1 (point)) |
| 6887 | pos2 pos3 pos4 pos5 s1 s2 state p pos45 | 6874 | pos2 pos3 pos4 pos5 s1 s2 state p pos45 |
| @@ -7069,7 +7056,7 @@ We suppose that the regexp is scanned already." | |||
| 7069 | (setq cperl-help-shown nil)) | 7056 | (setq cperl-help-shown nil)) |
| 7070 | 7057 | ||
| 7071 | (defun cperl-get-help-defer () | 7058 | (defun cperl-get-help-defer () |
| 7072 | (when (memq major-mode '(perl-mode cperl-mode)) | 7059 | (if (not (memq major-mode '(perl-mode cperl-mode))) nil |
| 7073 | (let ((cperl-message-on-help-error nil) (cperl-help-from-timer t)) | 7060 | (let ((cperl-message-on-help-error nil) (cperl-help-from-timer t)) |
| 7074 | (cperl-get-help) | 7061 | (cperl-get-help) |
| 7075 | (setq cperl-help-shown t)))) | 7062 | (setq cperl-help-shown t)))) |
| @@ -7091,8 +7078,9 @@ We suppose that the regexp is scanned already." | |||
| 7091 | (defun cperl-fontify-syntaxically (end) | 7078 | (defun cperl-fontify-syntaxically (end) |
| 7092 | ;; Some vars for debugging only | 7079 | ;; Some vars for debugging only |
| 7093 | ;; (message "Syntaxifying...") | 7080 | ;; (message "Syntaxifying...") |
| 7094 | (let (start (dbg (point)) (iend end) | 7081 | (let ((dbg (point)) (iend end) |
| 7095 | (istate (car cperl-syntax-state))) | 7082 | (istate (car cperl-syntax-state)) |
| 7083 | start) | ||
| 7096 | (and cperl-syntaxify-unwind | 7084 | (and cperl-syntaxify-unwind |
| 7097 | (setq end (cperl-unwind-to-safe t end))) | 7085 | (setq end (cperl-unwind-to-safe t end))) |
| 7098 | (setq start (point)) | 7086 | (setq start (point)) |
| @@ -7113,7 +7101,7 @@ We suppose that the regexp is scanned already." | |||
| 7113 | dbg iend | 7101 | dbg iend |
| 7114 | start end cperl-syntax-done-to | 7102 | start end cperl-syntax-done-to |
| 7115 | istate (car cperl-syntax-state))) ; For debugging | 7103 | istate (car cperl-syntax-state))) ; For debugging |
| 7116 | nil)) ; Do not iterate | 7104 | nil)) ; Do not iterate |
| 7117 | 7105 | ||
| 7118 | (defun cperl-fontify-update (end) | 7106 | (defun cperl-fontify-update (end) |
| 7119 | (let ((pos (point)) prop posend) | 7107 | (let ((pos (point)) prop posend) |
| @@ -7122,7 +7110,7 @@ We suppose that the regexp is scanned already." | |||
| 7122 | (setq posend (next-single-property-change pos 'cperl-postpone nil end)) | 7110 | (setq posend (next-single-property-change pos 'cperl-postpone nil end)) |
| 7123 | (and prop (put-text-property pos posend (car prop) (cdr prop))) | 7111 | (and prop (put-text-property pos posend (car prop) (cdr prop))) |
| 7124 | (setq pos posend))) | 7112 | (setq pos posend))) |
| 7125 | nil) ; Do not iterate | 7113 | nil) ; Do not iterate |
| 7126 | 7114 | ||
| 7127 | (defun cperl-update-syntaxification (from to) | 7115 | (defun cperl-update-syntaxification (from to) |
| 7128 | (if (and cperl-use-syntax-table-text-property | 7116 | (if (and cperl-use-syntax-table-text-property |
| @@ -7135,7 +7123,7 @@ We suppose that the regexp is scanned already." | |||
| 7135 | (cperl-fontify-syntaxically to))))) | 7123 | (cperl-fontify-syntaxically to))))) |
| 7136 | 7124 | ||
| 7137 | (defvar cperl-version | 7125 | (defvar cperl-version |
| 7138 | (let ((v "Revision: 4.32")) | 7126 | (let ((v "Revision: 4.35")) |
| 7139 | (string-match ":\\s *\\([0-9.]+\\)" v) | 7127 | (string-match ":\\s *\\([0-9.]+\\)" v) |
| 7140 | (substring v (match-beginning 1) (match-end 1))) | 7128 | (substring v (match-beginning 1) (match-end 1))) |
| 7141 | "Version of IZ-supported CPerl package this file is based on.") | 7129 | "Version of IZ-supported CPerl package this file is based on.") |