merge trunk
[bpt/emacs.git] / lisp / progmodes / cperl-mode.el
index 13fa310..3dda0c9 100644 (file)
@@ -1,6 +1,6 @@
 ;;; cperl-mode.el --- Perl code editing commands for Emacs
 
-;; Copyright (C) 1985-1987, 1991-201 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1987, 1991-2014 Free Software Foundation, Inc.
 
 ;; Author: Ilya Zakharevich
 ;;     Bob Olson
@@ -412,15 +412,15 @@ Affects: `cperl-font-lock', `cperl-electric-lbrace-space',
  "use cperl-vc-rcs-header or cperl-vc-sccs-header instead."
  "22.1")
 
-(defcustom cperl-clobber-mode-lists
-  (not
-   (and
-    (boundp 'interpreter-mode-alist)
-    (assoc "miniperl" interpreter-mode-alist)
-    (assoc "\\.\\([pP][Llm]\\|al\\)$" auto-mode-alist)))
-  "*Whether to install us into `interpreter-' and `extension' mode lists."
-  :type 'boolean
-  :group 'cperl)
+;; (defcustom cperl-clobber-mode-lists
+;;   (not
+;;    (and
+;;     (boundp 'interpreter-mode-alist)
+;;     (assoc "miniperl" interpreter-mode-alist)
+;;     (assoc "\\.\\([pP][Llm]\\|al\\)$" auto-mode-alist)))
+;;   "*Whether to install us into `interpreter-' and `extension' mode lists."
+;;   :type 'boolean
+;;   :group 'cperl)
 
 (defcustom cperl-info-on-command-no-prompt nil
   "*Not-nil (and non-null) means not to prompt on C-h f.
@@ -565,6 +565,7 @@ If nil, the value of `cperl-indent-level' will be used."
   "*Non-nil means that the _ (underline) should be treated as word char."
   :type 'boolean
   :group 'cperl)
+(make-obsolete-variable 'cperl-under-as-char 'superword-mode "24.4")
 
 (defcustom cperl-extra-perl-args ""
   "*Extra arguments to use when starting Perl.
@@ -958,7 +959,7 @@ B) Speed of editing operations.
   `cperl-array-face'                   Array names
   `cperl-hash-face'                    Hash names
   `font-lock-comment-face'     Comments, PODs and whatever is considered
-                               syntaxically to be not code
+                               syntactically to be not code
   `font-lock-constant-face'    HERE-doc delimiters, labels, delimiters of
                                2-arg operators s/y/tr/ or of RExen,
   `font-lock-warning-face'     Special-cased m// and s//foo/,
@@ -970,7 +971,7 @@ B) Speed of editing operations.
   `cperl-nonoverridable-face'  Non-overridable keywords, modifiers of RExen
   `font-lock-string-face'      Strings, qw() constructs, RExen, POD sections,
                                literal parts and the terminator of formats
-                               and whatever is syntaxically considered
+                               and whatever is syntactically considered
                                as string literals
   `font-lock-type-face'                Overridable keywords
   `font-lock-variable-name-face' Variable declarations, indirect array and
@@ -1537,8 +1538,8 @@ default.)  You can always quote (with \\[quoted-insert]) the left
 since most the time you mean \"less\".  CPerl mode tries to guess
 whether you want to type pair <>, and inserts is if it
 appropriate.  You can set `cperl-electric-parens-string' to the string that
-contains the parenths from the above list you want to be electrical.
-Electricity of parenths is controlled by `cperl-electric-parens'.
+contains the parens from the above list you want to be electrical.
+Electricity of parens is controlled by `cperl-electric-parens'.
 You may also set `cperl-electric-parens-mark' to have electric parens
 look for active mark and \"embrace\" a region if possible.'
 
@@ -1551,7 +1552,7 @@ and POD directives (Disabled by default, see `cperl-electric-keywords'.)
 
 The user types the keyword immediately followed by a space, which
 causes the construct to be expanded, and the point is positioned where
-she is most likely to want to be.  eg. when the user types a space
+she is most likely to want to be.  E.g., when the user types a space
 following \"if\" the following appears in the buffer: if () { or if ()
 } { } and the cursor is between the parentheses.  The user can then
 type some boolean expression within the parens.  Having done that,
@@ -1742,6 +1743,13 @@ or as help on variables `cperl-tips', `cperl-problems',
   (setq outline-regexp cperl-outline-regexp)
   (make-local-variable 'outline-level)
   (setq outline-level 'cperl-outline-level)
+  (make-local-variable 'add-log-current-defun-function)
+  (setq add-log-current-defun-function
+       (lambda ()
+         (save-excursion
+           (if (re-search-backward "^sub[ \t]+\\([^({ \t\n]+\\)" nil t)
+               (match-string-no-properties 1)))))
+
   (make-local-variable 'paragraph-start)
   (setq paragraph-start (concat "^$\\|" page-delimiter))
   (make-local-variable 'paragraph-separate)
@@ -1832,13 +1840,19 @@ or as help on variables `cperl-tips', `cperl-problems',
   (make-local-variable 'cperl-syntax-state)
   (setq cperl-syntax-state nil)                ; reset syntaxification cache
   (if cperl-use-syntax-table-text-property
-      (if (boundp 'syntax-propertize-function)
+      (if (eval-when-compile (fboundp 'syntax-propertize-rules))
           (progn
             ;; Reset syntaxification cache.
             (set (make-local-variable 'cperl-syntax-done-to) nil)
             (set (make-local-variable 'syntax-propertize-function)
                  (lambda (start end)
-                   (goto-char start) (cperl-fontify-syntaxically end))))
+                   (goto-char start)
+                   ;; Even if cperl-fontify-syntaxically has already gone
+                   ;; beyond `start', syntax-propertize has just removed
+                   ;; syntax-table properties between start and end, so we have
+                   ;; to re-apply them.
+                   (setq cperl-syntax-done-to start)
+                   (cperl-fontify-syntaxically end))))
        (make-local-variable 'parse-sexp-lookup-properties)
        ;; Do not introduce variable if not needed, we check it!
        (set 'parse-sexp-lookup-properties t)
@@ -1892,7 +1906,7 @@ or as help on variables `cperl-tips', `cperl-problems',
   (and (boundp 'msb-menu-cond)
        (not cperl-msb-fixed)
        (cperl-msb-fix))
-  (if (featurep 'easymenu)
+  (if (fboundp 'easy-menu-add)
       (easy-menu-add cperl-menu))      ; A NOP in Emacs.
   (run-mode-hooks 'cperl-mode-hook)
   (if cperl-hook-after-change
@@ -2322,8 +2336,7 @@ to nil."
                                                 nil t)))) ; Only one
                     (progn
                       (forward-word 1)
-                      (setq name (file-name-sans-extension
-                                  (file-name-nondirectory (buffer-file-name)))
+                      (setq name (file-name-base)
                             p (point))
                       (insert " NAME\n\n" name
                               " - \n\n=head1 SYNOPSIS\n\n\n\n"
@@ -3108,8 +3121,10 @@ and closing parentheses and brackets."
         ((eq 'continuation (elt i 0))
          ;; [continuation statement-start char-after is-block is-brace]
          (goto-char (elt i 1))         ; statement-start
-         (+ (if (memq (elt i 2) (append "}])" nil)) ; char-after
-                0                      ; Closing parenth
+         (+ (if (or (memq (elt i 2) (append "}])" nil)) ; char-after
+                     (eq 'continuation ; do not stagger continuations
+                         (elt (cperl-sniff-for-indent parse-data) 0)))
+                0 ; Closing parenth or continuation of a continuation
               cperl-continued-statement-offset)
             (if (or (elt i 3)          ; is-block
                     (not (elt i 4))            ; is-brace
@@ -3498,7 +3513,8 @@ Works before syntax recognition is done."
     (if end
        ;; Do the same for end, going small steps
        (save-excursion
-         (while (and end (get-text-property end 'syntax-type))
+         (while (and end (< end (point-max))
+                     (get-text-property end 'syntax-type))
            (setq pos end
                  end (next-single-property-change end 'syntax-type nil (point-max)))
            (if end (progn (goto-char end)
@@ -3517,7 +3533,7 @@ Works before syntax recognition is done."
 (defvar font-lock-warning-face)
 
 (defun cperl-find-sub-attrs (&optional st-l b-fname e-fname pos)
-  "Syntaxically mark (and fontify) attributes of a subroutine.
+  "Syntactically mark (and fontify) attributes of a subroutine.
 Should be called with the point before leading colon of an attribute."
   ;; Works *before* syntax recognition is done
   (or st-l (setq st-l (list nil)))     ; Avoid overwriting '()
@@ -4994,7 +5010,7 @@ conditional/loop constructs."
          (setq top (point))
          ;; Plan A: if line has an unfinished paren-group, go to end-of-group
          (while (= -1 (nth 0 (parse-partial-sexp (point) tmp-end -1)))
-           (setq top (point)))         ; Get the outermost parenths in line
+           (setq top (point)))         ; Get the outermost parens in line
          (goto-char top)
          (while (< (point) tmp-end)
            (parse-partial-sexp (point) tmp-end nil t) ; To start-sexp or eol
@@ -5906,7 +5922,7 @@ indentation and initial hashes.  Behaves usually outside of comment."
                       3 font-lock-variable-name-face)))
            '("\\<for\\(each\\)?\\([ \t]+\\(my\\|local\\|our\\)\\)?[ \t]*\\(\\$[a-zA-Z_][a-zA-Z_0-9]*\\)[ \t]*("
              4 font-lock-variable-name-face)
-           ;; Avoid $!, and s!!, qq!! etc. when not fontifying syntaxically
+           ;; Avoid $!, and s!!, qq!! etc. when not fontifying syntactically
            '("\\(?:^\\|[^smywqrx$]\\)\\(!\\)" 1 font-lock-negation-char-face)
            '("\\[\\(\\^\\)" 1 font-lock-negation-char-face prepend)))
          (setq
@@ -6201,6 +6217,10 @@ indentation and initial hashes.  Behaves usually outside of comment."
     (error (message "cperl-init-faces (ignored): %s" errs))))
 
 
+(defvar ps-bold-faces)
+(defvar ps-italic-faces)
+(defvar ps-underlined-faces)
+
 (defun cperl-ps-print-init ()
   "Initialization of `ps-print' components for faces used in CPerl."
   (eval-after-load "ps-print"
@@ -6514,6 +6534,9 @@ side-effect of memorizing only.  Examples in `cperl-style-examples'."
   (let ((perl-dbg-flags (concat cperl-extra-perl-args " -wc")))
     (eval '(mode-compile))))           ; Avoid a warning
 
+(declare-function Info-find-node "info"
+                 (filename nodename &optional no-going-back strict-case))
+
 (defun cperl-info-buffer (type)
   ;; Returns buffer with documentation.  Creates if missing.
   ;; If TYPE, this vars buffer.
@@ -6652,10 +6675,13 @@ Customized by setting variables `cperl-shrink-wrap-info-frame',
   (buffer-substring
    (match-beginning 1) (match-end 1)))
 
+(declare-function imenu-choose-buffer-index "imenu" (&optional prompt alist))
+
 (defun cperl-imenu-on-info ()
   "Shows imenu for Perl Info Buffer.
 Opens Perl Info buffer if needed."
   (interactive)
+  (require 'imenu)
   (let* ((buffer (current-buffer))
         imenu-create-index-function
         imenu-prev-index-position-function
@@ -7115,6 +7141,10 @@ Use as
 (defvar cperl-hierarchy '(() ())
   "Global hierarchy of classes.")
 
+;; Follows call to (autoloaded) visit-tags-table.
+(declare-function file-of-tag "etags" (&optional relative))
+(declare-function etags-snarf-tag "etags" (&optional use-explicit))
+
 (defun cperl-tags-hier-fill ()
   ;; Suppose we are in a tag table cooked by cperl.
   (goto-char 1)
@@ -7158,6 +7188,7 @@ Use as
       (end-of-line))))
 
 (declare-function x-popup-menu "menu.c" (position menu))
+(declare-function etags-goto-tag-location "etags" (tag-info))
 
 (defun cperl-tags-hier-init (&optional update)
   "Show hierarchical menu of classes and methods.
@@ -8501,6 +8532,8 @@ the appropriate statement modifier."
     ;;(error "Not at `if', `unless', `while', `until', `for' or `foreach'")
     (cperl-invert-if-unless-modifiers)))
 
+(declare-function Man-getpage-in-background "man" (topic))
+
 ;;; By Anthony Foiani <afoiani@uswest.com>
 ;;; Getting help on modules in C-h f ?
 ;;; This is a modified version of `man'.
@@ -8867,8 +8900,9 @@ do extra unwind via `cperl-unwind-to-safe'."
                  (beginning-of-line)
                  (eq (get-text-property (setq beg (point)) 'syntax-type)
                      'multiline)))
-      (if (setq beg (cperl-beginning-of-property beg 'syntax-type))
-         (goto-char beg)))
+      (let ((new-beg (cperl-beginning-of-property beg 'syntax-type)))
+       (setq beg (if (= new-beg beg) nil new-beg))
+       (goto-char new-beg)))
     (setq beg (point))
     (goto-char end)
     (while (and end
@@ -8951,14 +8985,15 @@ do extra unwind via `cperl-unwind-to-safe'."
       (setq cperl-syntax-done-to (min cperl-syntax-done-to beg))))
 
 (defun cperl-update-syntaxification (from to)
-  (if (and cperl-use-syntax-table-text-property
-          cperl-syntaxify-by-font-lock
-          (or (null cperl-syntax-done-to)
-              (< cperl-syntax-done-to to)))
-      (progn
-       (save-excursion
-         (goto-char from)
-         (cperl-fontify-syntaxically to)))))
+  (cond
+   ((not cperl-use-syntax-table-text-property) nil)
+   ((fboundp 'syntax-propertize) (syntax-propertize to))
+   ((and cperl-syntaxify-by-font-lock
+         (or (null cperl-syntax-done-to)
+             (< cperl-syntax-done-to to)))
+    (save-excursion
+      (goto-char from)
+      (cperl-fontify-syntaxically to)))))
 
 (defvar cperl-version
   (let ((v  "Revision: 6.2"))