SQL mode version 2.1

[gnu-emacs] / lisp / progmodes / cperl-mode.el

diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index 722a31eae805fb0323b3c6f33f636512e1d77953..d69cce76faa86f0a6a35785ce62a02d8d89e269d 100644 (file)
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -1,7 +1,7 @@
 ;;; cperl-mode.el --- Perl code editing commands for Emacs
 
 ;; Copyright (C) 1985, 1986, 1987, 1991, 1992, 1993, 1994, 1995, 1996, 1997,
-;; 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
+;; 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
 ;;     Free Software Foundation, Inc.
 
 ;; Author: Ilya Zakharevich
@@ -5693,7 +5693,7 @@ indentation and initial hashes.  Behaves usually outside of comment."
          (setq
           t-font-lock-keywords
           (list
-           (list "[ \t]+$" 0 cperl-invalid-face t)
+           `("[ \t]+$" 0 ',cperl-invalid-face t)
            (cons
             (concat
              "\\(^\\|[^$@%&\\]\\)\\<\\("
@@ -6874,6 +6874,19 @@ by CPerl."
        ;; Do not introduce variable if not needed, we check it!
        (set 'parse-sexp-lookup-properties t))))
 
+;; Copied from imenu-example--name-and-position.
+(defvar imenu-use-markers)
+
+(defun cperl-imenu-name-and-position ()
+  "Return the current/previous sexp and its (beginning) location.
+Does not move point."
+  (save-excursion
+    (forward-sexp -1)
+    (let ((beg (if imenu-use-markers (point-marker) (point)))
+         (end (progn (forward-sexp) (point))))
+      (cons (buffer-substring beg end)
+           beg))))
+
 (defun cperl-xsub-scan ()
   (require 'imenu)
   (let ((index-alist '())
@@ -6896,7 +6909,7 @@ by CPerl."
         ((not package) nil)            ; C language section
         ((match-beginning 3)           ; XSUB
          (goto-char (1+ (match-beginning 3)))
-         (setq index (imenu-example--name-and-position))
+         (setq index (cperl-imenu-name-and-position))
          (setq name (buffer-substring (match-beginning 3) (match-end 3)))
          (if (and prefix (string-match (concat "^" prefix) name))
              (setq name (substring name (length prefix))))
@@ -6908,7 +6921,7 @@ by CPerl."
          (push index index-alist))
         (t                             ; BOOT: section
          ;; (beginning-of-line)
-         (setq index (imenu-example--name-and-position))
+         (setq index (cperl-imenu-name-and-position))
          (setcar index (concat package "::BOOT:"))
          (push index index-alist)))))
     index-alist))
@@ -7158,7 +7171,7 @@ Use as
                        (cons cons1 (car cperl-hierarchy)))))))
       (end-of-line))))
 
-(declare-function x-popup-menu "xmenu.c" (position menu))
+(declare-function x-popup-menu "menu.c" (position menu))
 
 (defun cperl-tags-hier-init (&optional update)
   "Show hierarchical menu of classes and methods.
@@ -8558,8 +8571,7 @@ the appropriate statement modifier."
   (let* ((pod2man-args (concat buffer-file-name " | nroff -man "))
         (bufname (concat "Man " buffer-file-name))
         (buffer (generate-new-buffer bufname)))
-    (save-excursion
-      (set-buffer buffer)
+    (with-current-buffer buffer
       (let ((process-environment (copy-sequence process-environment)))
         ;; Prevent any attempt to use display terminal fanciness.
         (setenv "TERM" "dumb")
@@ -8758,7 +8770,8 @@ start with default arguments, then refine the slowdown regions."
                             (let ((tt (current-time)))
                               (+ (* 1000 (nth 1 tt)) (/ (nth 2 tt) 1000))))))
         (tt (funcall timems)) (c 0) delta tot)
-    (goto-line l)
+    (goto-char (point-min))
+    (forward-line (1- l))
     (cperl-mode)
     (setq tot (- (- tt (setq tt (funcall timems)))))
     (message "cperl-mode at %s: %s" l tot)
@@ -8967,6 +8980,18 @@ do extra unwind via `cperl-unwind-to-safe'."
     (substring v (match-beginning 1) (match-end 1)))
   "Version of IZ-supported CPerl package this file is based on.")
 
+(defun cperl-mode-unload-function ()
+  "Unload the Cperl mode library."
+  (let ((new-mode (if (eq (symbol-function 'perl-mode) 'cperl-mode)
+                     'fundamental-mode
+                   'perl-mode)))
+    (dolist (buf (buffer-list))
+      (with-current-buffer buf
+       (when (eq major-mode 'cperl-mode)
+         (funcall new-mode)))))
+  ;; continue standard unloading
+  nil)
+
 (provide 'cperl-mode)
 
 ;; arch-tag: 42e5b19b-e187-4537-929f-1a7408980ce6