(perl-mode): Use define-derived-mode.

(perl-comment-indent): Simplify to let newcomment.el do its job.
(perl-electric-terminator, perl-calculate-indent, perl-indent-exp)
(perl-mark-function): Cleanup the namespace.
(perl-calculate-indent): Don't be fooled by nested functions.

1 files changed, 69 insertions, 81 deletions

diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el
index 189b11922aa..98d2035112a 100644
--- a/lisp/progmodes/perl-mode.el
+++ b/lisp/progmodes/perl-mode.el
@@ -50,13 +50,13 @@
 ;; the line ends in a quoted string, or has a # which should be a \#.
 
 ;; If your machine is slow, you may want to remove some of the bindings
-;; to electric-perl-terminator.  I changed the indenting defaults to be
+;; to perl-electric-terminator.  I changed the indenting defaults to be
 ;; what Larry Wall uses in perl/lib, but left in all the options.
 
 ;; I also tuned a few things:  comments and labels starting in column
-;; zero are left there by indent-perl-exp; perl-beginning-of-function
+;; zero are left there by perl-indent-exp; perl-beginning-of-function
 ;; goes back to the first open brace/paren in column zero, the open brace
-;; in 'sub ... {', or the equal sign in 'format ... ='; indent-perl-exp
+;; in 'sub ... {', or the equal sign in 'format ... ='; perl-indent-exp
 ;; (meta-^q) indents from the current line through the close of the next
 ;; brace/paren, so you don't need to start exactly at a brace or paren.
 
@@ -89,9 +89,6 @@
 ;;
 ;;     /`/; $ugly = q?"'$?; /`/;
 ;;
-;; To solve problem 6, add a /{/; before each use of ${var}:
-;;     /{/; while (<${glob_me}>) ...
-;;
 ;; Problem 7 is even worse, but this 'fix' does work :-(
 ;;     $DB'stop#'
 ;;         [$DB'line#'
@@ -99,68 +96,60 @@
 
 ;;; Code:
 
+(eval-when-compile (require 'cl))
+
 (defgroup perl nil
   "Major mode for editing Perl code."
   :prefix "perl-"
   :group 'languages)
 
-(defvar perl-mode-abbrev-table nil
-  "Abbrev table in use in perl-mode buffers.")
-(define-abbrev-table 'perl-mode-abbrev-table ())
-
-(defvar perl-mode-map ()
-  "Keymap used in Perl mode.")
-(if perl-mode-map
-    ()
-  (setq perl-mode-map (make-sparse-keymap))
-  (define-key perl-mode-map "{" 'electric-perl-terminator)
-  (define-key perl-mode-map "}" 'electric-perl-terminator)
-  (define-key perl-mode-map ";" 'electric-perl-terminator)
-  (define-key perl-mode-map ":" 'electric-perl-terminator)
-  (define-key perl-mode-map "\e\C-a" 'perl-beginning-of-function)
-  (define-key perl-mode-map "\e\C-e" 'perl-end-of-function)
-  (define-key perl-mode-map "\e\C-h" 'mark-perl-function)
-  (define-key perl-mode-map "\e\C-q" 'indent-perl-exp)
-  (define-key perl-mode-map "\177" 'backward-delete-char-untabify)
-  (define-key perl-mode-map "\t" 'perl-indent-command))
+(defvar perl-mode-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map "{" 'perl-electric-terminator)
+    (define-key map "}" 'perl-electric-terminator)
+    (define-key map ";" 'perl-electric-terminator)
+    (define-key map ":" 'perl-electric-terminator)
+    (define-key map "\e\C-a" 'perl-beginning-of-function)
+    (define-key map "\e\C-e" 'perl-end-of-function)
+    (define-key map "\e\C-h" 'perl-mark-function)
+    (define-key map "\e\C-q" 'perl-indent-exp)
+    (define-key map "\177" 'backward-delete-char-untabify)
+    (define-key map "\t" 'perl-indent-command)
+    map)
+  "Keymap used in `perl-mode'.")
 
 (autoload 'c-macro-expand "cmacexp"
   "Display the result of expanding all C macros occurring in the region.
 The expansion is entirely correct because it uses the C preprocessor."
   t)
 
-(defvar perl-mode-syntax-table nil
-  "Syntax table in use in perl-mode buffers.")
-
-(if perl-mode-syntax-table
-    ()
-  (setq perl-mode-syntax-table (make-syntax-table (standard-syntax-table)))
-  (modify-syntax-entry ?\n ">" perl-mode-syntax-table)
-  (modify-syntax-entry ?# "<" perl-mode-syntax-table)
-  (modify-syntax-entry ?$ "/" perl-mode-syntax-table)
-  (modify-syntax-entry ?% "." perl-mode-syntax-table)
-  (modify-syntax-entry ?& "." perl-mode-syntax-table)
-  (modify-syntax-entry ?\' "\"" perl-mode-syntax-table)
-  (modify-syntax-entry ?* "." perl-mode-syntax-table)
-  (modify-syntax-entry ?+ "." perl-mode-syntax-table)
-  (modify-syntax-entry ?- "." perl-mode-syntax-table)
-  (modify-syntax-entry ?/ "." perl-mode-syntax-table)
-  (modify-syntax-entry ?< "." perl-mode-syntax-table)
-  (modify-syntax-entry ?= "." perl-mode-syntax-table)
-  (modify-syntax-entry ?> "." perl-mode-syntax-table)
-  (modify-syntax-entry ?\\ "\\" perl-mode-syntax-table)
-  (modify-syntax-entry ?` "\"" perl-mode-syntax-table)
-  (modify-syntax-entry ?| "." perl-mode-syntax-table)
-)
+(defvar perl-mode-syntax-table
+  (let ((st (make-syntax-table (standard-syntax-table))))
+    (modify-syntax-entry ?\n ">" st)
+    (modify-syntax-entry ?# "<" st)
+    (modify-syntax-entry ?$ "/" st)
+    (modify-syntax-entry ?% "." st)
+    (modify-syntax-entry ?& "." st)
+    (modify-syntax-entry ?\' "\"" st)
+    (modify-syntax-entry ?* "." st)
+    (modify-syntax-entry ?+ "." st)
+    (modify-syntax-entry ?- "." st)
+    (modify-syntax-entry ?/ "." st)
+    (modify-syntax-entry ?< "." st)
+    (modify-syntax-entry ?= "." st)
+    (modify-syntax-entry ?> "." st)
+    (modify-syntax-entry ?\\ "\\" st)
+    (modify-syntax-entry ?` "\"" st)
+    (modify-syntax-entry ?| "." st)
+    st)
+  "Syntax table in use in `perl-mode' buffers.")
 
 (defvar perl-imenu-generic-expression
-  '(
-    ;; Functions
+  '(;; Functions
     (nil "^sub\\s-+\\([-A-Za-z0-9+_:]+\\)\\(\\s-\\|\n\\)*{" 1 )
     ;;Variables
     ("Variables" "^\\([$@%][-A-Za-z0-9+_:]+\\)\\s-*=" 1 )
-    ("Packages" "^package\\s-+\\([-A-Za-z0-9+_:]+\\);" 1 )
-    )
+    ("Packages" "^package\\s-+\\([-A-Za-z0-9+_:]+\\);" 1 ))
   "Imenu generic expression for Perl mode.  See `imenu-generic-expression'.")
 
 ;; Regexps updated with help from Tom Tromey <tromey@cambric.colorado.edu> and
@@ -172,13 +161,13 @@ The expansion is entirely correct because it uses the C preprocessor."
     ;;
     ;; Fontify preprocessor statements as we do in `c-font-lock-keywords'.
     ;; Ilya Zakharevich <ilya@math.ohio-state.edu> thinks this is a bad idea.
-    ("^#[ \t]*include[ \t]+\\(<[^>\"\n]+>\\)" 1 font-lock-string-face)
-    ("^#[ \t]*define[ \t]+\\(\\sw+\\)(" 1 font-lock-function-name-face)
-    ("^#[ \t]*if\\>"
-     ("\\<\\(defined\\)\\>[ \t]*(?\\(\\sw+\\)?" nil nil
-      (1 font-lock-constant-face) (2 font-lock-variable-name-face nil t)))
-    ("^#[ \t]*\\(\\sw+\\)\\>[ \t]*\\(\\sw+\\)?"
-     (1 font-lock-constant-face) (2 font-lock-variable-name-face nil t))
+    ;; ("^#[ \t]*include[ \t]+\\(<[^>\"\n]+>\\)" 1 font-lock-string-face)
+    ;; ("^#[ \t]*define[ \t]+\\(\\sw+\\)(" 1 font-lock-function-name-face)
+    ;; ("^#[ \t]*if\\>"
+    ;;  ("\\<\\(defined\\)\\>[ \t]*(?\\(\\sw+\\)?" nil nil
+    ;;   (1 font-lock-constant-face) (2 font-lock-variable-name-face nil t)))
+    ;; ("^#[ \t]*\\(\\sw+\\)\\>[ \t]*\\(\\sw+\\)?"
+    ;;  (1 font-lock-constant-face) (2 font-lock-variable-name-face nil t))
     ;;
     ;; Fontify function and package names in declarations.
     ("\\<\\(package\\|sub\\)\\>[ \t]*\\(\\sw+\\)?"
@@ -272,7 +261,7 @@ create a new comment."
   :group 'perl)
 
 ;;;###autoload
-(defun perl-mode ()
+(define-derived-mode perl-mode nil "Perl"
   "Major mode for editing Perl code.
 Expression and list commands understand all Perl brackets.
 Tab indents for Perl code.
@@ -317,13 +306,6 @@ Various indentation styles:       K&R  BSD  BLK  GNU  LW
   perl-label-offset               -5   -8   -2   -2   -2
 
 Turning on Perl mode runs the normal hook `perl-mode-hook'."
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map perl-mode-map)
-  (setq major-mode 'perl-mode)
-  (setq mode-name "Perl")
-  (setq local-abbrev-table perl-mode-abbrev-table)
-  (set-syntax-table perl-mode-syntax-table)
   (make-local-variable 'paragraph-start)
   (setq paragraph-start (concat "$\\|" page-delimiter))
   (make-local-variable 'paragraph-separate)
@@ -353,8 +335,7 @@ Turning on Perl mode runs the normal hook `perl-mode-hook'."
   ;; Tell imenu how to handle Perl.
   (make-local-variable 'imenu-generic-expression)
   (setq imenu-generic-expression perl-imenu-generic-expression)
-  (setq imenu-case-fold-search nil)
-  (run-hooks 'perl-mode-hook))
+  (setq imenu-case-fold-search nil))
 
 ;; This is used by indent-for-comment
 ;; to decide how much to indent a comment in Perl code
@@ -362,14 +343,10 @@ Turning on Perl mode runs the normal hook `perl-mode-hook'."
 (defun perl-comment-indent ()
   (if (and (bolp) (not (eolp)))
       0                                 ;Existing comment at bol stays there.
-    (save-excursion
-      (skip-chars-backward " \t")
-      (max (if (bolp)                   ;Else indent at comment column
-               0                        ; except leave at least one space if
-             (1+ (current-column)))     ; not at beginning of line.
-           comment-column))))
-
-(defun electric-perl-terminator (arg)
+    comment-column))
+
+(defalias 'electric-perl-terminator 'perl-electric-terminator)
+(defun perl-electric-terminator (arg)
   "Insert character and adjust indentation.
 If at end-of-line, and not in a comment or a quote, correct the's indentation."
   (interactive "P")
@@ -482,7 +459,7 @@ changed by, or (parse-state) if line starts in a quoted string."
     (setq beg (point))
     (setq shift-amt
           (cond ((= (char-after bof) ?=) 0)
-                ((listp (setq indent (calculate-perl-indent bof))) indent)
+                ((listp (setq indent (perl-calculate-indent bof))) indent)
                 ((looking-at (or nochange perl-nochange)) 0)
                 (t
                  (skip-chars-forward " \t\f")
@@ -503,7 +480,7 @@ changed by, or (parse-state) if line starts in a quoted string."
         (goto-char (- (point-max) pos)))
     shift-amt))
 
-(defun calculate-perl-indent (&optional parse-start)
+(defun perl-calculate-indent (&optional parse-start)
   "Return appropriate indentation for current line as Perl code.
 In usual case returns an integer: the column to indent to.
 Returns (parse-state) if line starts inside a string."
@@ -516,6 +493,15 @@ Returns (parse-state) if line starts inside a string."
       (if parse-start                   ;used to avoid searching
           (goto-char parse-start)
         (perl-beginning-of-function))
+      ;; We might be now looking at a local function that has nothing to
+      ;; do with us because `indent-point' is past it.  In this case
+      ;; look further back up for another `perl-beginning-of-function'.
+      (while (and (looking-at "{")
+                  (save-excursion
+                    (beginning-of-line)
+                    (looking-at "\\s-+sub\\>"))
+                  (> indent-point (save-excursion (forward-sexp 1) (point))))
+        (perl-beginning-of-function))
       (while (< (point) indent-point)   ;repeat until right sexp
         (setq parse-start (point))
         (setq state (parse-partial-sexp (point) indent-point 0))
@@ -643,7 +629,8 @@ Returns (parse-state) if line starts inside a string."
   (skip-chars-forward " \t\f"))
 
 ;; note: this may be slower than the c-mode version, but I can understand it.
-(defun indent-perl-exp ()
+(defalias 'indent-perl-exp 'perl-indent-exp)
+(defun perl-indent-exp ()
   "Indent each line of the Perl grouping following point."
   (interactive)
   (let* ((case-fold-search nil)
@@ -741,7 +728,8 @@ With argument, repeat that many times; negative args move backward."
               (goto-char (point-min)))))
       (setq arg (1+ arg)))))
 
-(defun mark-perl-function ()
+(defalias 'mark-perl-function 'perl-mark-function)
+(defun perl-mark-function ()
   "Put mark at end of Perl function, point at beginning."
   (interactive)
   (push-mark (point))