diff lisp/modes/cperl-mode.el @ 70:131b0175ea99 r20-0b30

Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents e04119814345
children dbb370e3c29e
line wrap: on
line diff
--- a/lisp/modes/cperl-mode.el	Mon Aug 13 09:00:04 2007 +0200
+++ b/lisp/modes/cperl-mode.el	Mon Aug 13 09:02:59 2007 +0200
@@ -32,7 +32,7 @@
 ;;; Corrections made by Ilya Zakharevich ilya@math.mps.ohio-state.edu
 ;;; XEmacs changes by Peter Arius arius@informatik.uni-erlangen.de
 
-;; $Id: cperl-mode.el,v 1.4 1997/03/16 05:55:19 steve Exp $
+;; $Id: cperl-mode.el,v 1.1.1.1 1996/12/18 22:42:48 steve Exp $
 
 ;;; To use this mode put the following into your .emacs file:
 
@@ -46,10 +46,6 @@
 ;;; in your .emacs file. (Emacs rulers do not consider it politically
 ;;; correct to make whistles enabled by default.)
 
-;;; DO NOT FORGET to read micro-docs. (available from `Perl' menu). <<<<<<
-;;; or as help on variables `cperl-tips', `cperl-problems',         <<<<<<
-;;; `cperl-non-problems'.                                           <<<<<<
-
 ;;; Additional useful commands to put into your .emacs file:
 
 ;; (setq auto-mode-alist
@@ -332,28 +328,6 @@
 ;;;  Minor updates to `cperl-short-docs'.
 ;;;  Will not consider <<= as start of here-doc.
 
-;;;; After 1.29
-;;;  Added an extra advice to look into Micro-docs. ;-).
-;;;  Enclosing of region when you press a closing parenth is regulated by
-;;;  `cperl-electric-parens-string'.
-;;;  Minor updates to `cperl-short-docs'.
-;;;  `initialize-new-tags-table' called only if present (Does this help
-;;;     with generation of tags under XEmacs?).
-;;;  When creating/updating tag files, new info is written at the old place,
-;;;     or at the end (is this a wanted behaviour? I need this in perl build directory).
-
-;;;; After 1.30
-;;;  All the keywords from keywords.pl included (maybe with dummy explanation).
-;;;  No auto-help inside strings, comment, here-docs, formats, and pods.
-;;;  Shrinkwrapping of info, regulated by `cperl-max-help-size'.
-;;;  Info on variables as well.
-;;;  Recognision of HERE-DOCS improved yet more.
-;;;  Autonewline works on `}' without warnings.
-;;;  Autohelp works again on $_[0].
-
-;;;; After 1.31
-;;;  perl-descr.el found its author - hi, Johan!
-
 (defvar cperl-extra-newline-before-brace nil
   "*Non-nil means that if, elsif, while, until, else, for, foreach
 and do constructs look like:
@@ -414,7 +388,7 @@
   "*Non-nil (and non-null) means { after $ in CPerl buffers should be preceeded by ` '.
 Can be overwritten by `cperl-hairy' if nil.")
 
-(defvar cperl-electric-parens-string "({[]})<"
+(defvar cperl-electric-parens-string "({[<"
   "*String of parentheses that should be electric in CPerl.")
 
 (defvar cperl-electric-parens nil
@@ -481,12 +455,6 @@
   "*Not-nil means add backreferences to generated `imenu's.
 May require patched `imenu' and `imenu-go'.")
 
-(defvar cperl-max-help-size 66
-  "*Non-nil means shrink-wrapping of info-buffer allowed up to these percents.")
-
-(defvar cperl-shrink-wrap-info-frame t
-  "*Non-nil means shrink-wrapping of info-buffer-frame allowed.")
-
 (defvar cperl-info-page "perl"
   "Name of the info page containing perl docs.
 Older version of this page was called `perl5', newer `perl'.")
@@ -580,10 +548,6 @@
 	1 if ( s#//#/# );
 will.
 
-By similar reasons
-	s\"abc\"def\";
-will confuse CPerl a lot.
-
 If you still get wrong indentation in situation that you think the
 code should be able to parse, try:
 
@@ -1230,10 +1194,10 @@
 		   (if cperl-auto-newline 
 		       (progn (cperl-indent-line) (newline) t) nil)))
 	  (progn
+	    (if cperl-auto-newline
+		(setq insertpos (point)))
 	    (insert last-command-char)
 	    (cperl-indent-line)
-	    (if cperl-auto-newline
-		(setq insertpos (1- (point))))
 	    (if (and cperl-auto-newline (null only-before))
 		(progn
 		  (newline)
@@ -1318,9 +1282,6 @@
   (interactive "P")
   (let ((beg (save-excursion (beginning-of-line) (point)))
 	(other-end (if (and cperl-electric-parens-mark
-			    (cperl-val 'cperl-electric-parens)
-			    (memq last-command-char
-				  (append cperl-electric-parens-string nil))
 			    (cperl-mark-active) 
 			    (< (mark) (point)))
 		       (mark) 
@@ -2176,20 +2137,9 @@
 	       "\\(\\`\n?\\|\n\n\\)=" 
 	       "\\|"
 	       ;; One extra () before this:
-	       "<<" 
-	         "\\(" 
-		 ;; First variant "BLAH" or just ``.
-	            "\\([\"'`]\\)"
-		    "\\([^\"'`\n]*\\)"
-		    "\\3"
-		 "\\|"
-		 ;; Second variant: Identifier or empty
-		   "\\(\\([a-zA-Z_][a-zA-Z_0-9]*\\)?\\)"
-		   ;; Check that we do not have <<= or << 30 or << $blah.
-		   "\\([^= \t$@%&]\\|[ \t]+[^ \t\n0-9$@%&]\\)"
-		 "\\)"
+	       "<<\\(\\([\"'`]\\)\\([^\"'`\n]*\\)\\3\\|\\(\\([a-zA-Z_][a-zA-Z_0-9]*\\)?\\)[^=]\\)" ; [^=] to avoid <<=.
 	       "\\|"
-	       ;; 1+6 extra () before this:
+	       ;; 1+5 extra () before this:
 	       "^[ \t]*format[ \t]*\\([a-zA-Z0-9_]+\\)?[ \t]*=[ \t]*$")))
     (unwind-protect
 	(progn
@@ -2290,12 +2240,12 @@
 			(t (message "End of here-document `%s' not found." tag)))))
 	       ;; format
 	       (t
-		;; 1+6=7 extra () before this:
+		;; 1+5=6 extra () before this:
 		;; "^[ \t]*format[ \t]*\\([a-zA-Z0-9_]+\\)?[ \t]*=[ \t]*$")))
 		(setq b (point)
-		      name (if (match-beginning 8) ; 7 + 1
-			       (buffer-substring (match-beginning 8) ; 7 + 1
-						 (match-end 8)) ; 7 + 1
+		      name (if (match-beginning 7) ; 6 + 1
+			       (buffer-substring (match-beginning 7) ; 6 + 1
+						 (match-end 7)) ; 6 + 1
 			     ""))
 		(setq argument nil)
 		(if cperl-pod-here-fontify 
@@ -3345,52 +3295,34 @@
   (let ((perl-dbg-flags "-wc"))
     (mode-compile)))
 
-(defun cperl-info-buffer (type)
-  ;; Returns buffer with documentation. Creates if missing.
-  ;; If TYPE, this vars buffer.
-  ;; Special care is taken to not stomp over an existing info buffer
-  (let* ((bname (if type "*info-perl-var*" "*info-perl*"))
-	 (info (get-buffer bname))
-	 (oldbuf (get-buffer "*info*")))
+(defun cperl-info-buffer ()
+  ;; Returns buffer with documentation. Creates if missing
+  (let ((info (get-buffer "*info-perl*")))
     (if info info
       (save-window-excursion
 	;; Get Info running
 	(require 'info)
-	(cond (oldbuf
-	       (set-buffer oldbuf)
-	       (rename-buffer "*info-perl-tmp*")))
 	(save-window-excursion
 	  (info))
-	(Info-find-node cperl-info-page (if type "perlvar" "perlfunc"))
+	(Info-find-node cperl-info-page "perlfunc")
 	(set-buffer "*info*")
-	(rename-buffer bname)
-	(cond (oldbuf
-	       (set-buffer "*info-perl-tmp*")
-	       (rename-buffer "*info*")
-	       (set-buffer bname)))
-	(make-variable-buffer-local 'window-min-height)
-	(setq window-min-height 2)
+	(rename-buffer "*info-perl*")
 	(current-buffer)))))
 
 (defun cperl-word-at-point (&optional p)
   ;; Returns the word at point or at P.
   (save-excursion
     (if p (goto-char p))
-    (or (cperl-word-at-point-hard)
-	(progn
-	  (require 'etags)
-	  (funcall (or (and (boundp 'find-tag-default-function)
-			    find-tag-default-function)
-		       (get major-mode 'find-tag-default-function)
-		       ;; XEmacs 19.12 has `find-tag-default-hook'; it is
-		       ;; automatically used within `find-tag-default':
-		       'find-tag-default))))))
+    (require 'etags)
+    (funcall (or (and (boundp 'find-tag-default-function)
+		      find-tag-default-function)
+		 (get major-mode 'find-tag-default-function)
+		 ;; XEmacs 19.12 has `find-tag-default-hook'; it is
+		 ;; automatically used within `find-tag-default':
+		 'find-tag-default))))
 
 (defun cperl-info-on-command (command)
-  "Shows documentation for Perl command in other window.
-If perl-info buffer is shown in some frame, uses this frame.
-Customized by setting variables `cperl-shrink-wrap-info-frame',
-`cperl-max-help-size'."
+  "Shows documentation for Perl command in other window."
   (interactive 
    (let* ((default (cperl-word-at-point))
 	  (read (read-string 
@@ -3402,72 +3334,21 @@
 
   (let ((buffer (current-buffer))
 	(cmd-desc (concat "^" (regexp-quote command) "[^a-zA-Z_0-9]")) ; "tr///"
-	pos isvar height iniheight frheight buf win fr1 fr2 iniwin not-loner
-	max-height char-height buf-list)
+	pos)
     (if (string-match "^-[a-zA-Z]$" command)
 	(setq cmd-desc "^-X[ \t\n]"))
-    (setq isvar (string-match "^[$@%]" command)
-	  buf (cperl-info-buffer isvar)
-	  iniwin (selected-window)
-	  fr1 (window-frame iniwin))
-    (set-buffer buf)
+    (set-buffer (cperl-info-buffer))
     (beginning-of-buffer)
-    (or isvar 
-	(progn (re-search-forward "^-X[ \t\n]")
-	       (forward-line -1)))
+    (re-search-forward "^-X[ \t\n]")
+    (forward-line -1)
     (if (re-search-forward cmd-desc nil t)
 	(progn
-	  ;; Go back to beginning of the group (ex, for qq)
-	  (if (re-search-backward "^[ \t\n\f]")
-	      (forward-line 1))
-	  (beginning-of-line)
-	  ;; Get some of 
-	  (setq pos (point)
-		buf-list (list buf "*info-perl-var*" "*info-perl*"))
-	  (while (and (not win) buf-list)
-	    (setq win (get-buffer-window (car buf-list) t))
-	    (setq buf-list (cdr buf-list)))
-	  (or (not win)
-	      (eq (window-buffer win) buf)
-	      (set-window-buffer win buf))
-	  (and win (setq fr2 (window-frame win)))
-	  (if (or (not fr2) (eq fr1 fr2))
-	      (pop-to-buffer buf)
-	    (special-display-popup-frame buf) ; Make it visible
-	    (select-window win))
-	  (goto-char pos)		; Needed (?!).
-	  ;; Resize
-	  (setq iniheight (window-height)
-		frheight (frame-height)
-		not-loner (< iniheight (1- frheight))) ; Are not alone
-	  (cond ((if not-loner cperl-max-help-size 
-		   cperl-shrink-wrap-info-frame)
-		 (setq height 
-		       (+ 2 
-			  (count-lines 
-			   pos 
-			   (save-excursion
-			     (if (re-search-forward
-				  "^[ \t][^\n]*\n+\\([^ \t\n\f]\\|\\'\\)" nil t)
-				 (match-beginning 0) (point-max)))))
-		       max-height 
-		       (if not-loner
-			   (/ (* (- frheight 3) cperl-max-help-size) 100)
-			 (setq char-height (frame-char-height))
-			 ;; Non-functioning under OS/2:
-			 (if (eq char-height 1) (setq char-height 18))
-			 ;; Title, menubar, + 2 for slack
-			 (- (/ (x-display-pixel-height) char-height) 4)
-			 ))
-		 (if (> height max-height) (setq height max-height))
-		 ;;(message "was %s doing %s" iniheight height)
-		 (if not-loner
-		     (enlarge-window (- height iniheight))
-		   (set-frame-height (window-frame win) (1+ height)))))
+	  (setq pos (progn (beginning-of-line)
+			   (point)))
+	  (pop-to-buffer (cperl-info-buffer))
 	  (set-window-start (selected-window) pos))
       (message "No entry for %s found." command))
-    ;;(pop-to-buffer buffer)
-    (select-window iniwin)))
+    (pop-to-buffer buffer)))
 
 (defun cperl-info-on-current-command ()
   "Shows documentation for Perl command at point in other window."
@@ -3492,7 +3373,7 @@
 	 imenu-extract-index-name-function 
 	 (index-item (save-restriction
 		       (save-window-excursion
-			 (set-buffer (cperl-info-buffer nil))
+			 (set-buffer (cperl-info-buffer))
 			 (setq imenu-create-index-function 
 			       'imenu-default-create-index-function
 			       imenu-prev-index-position-function
@@ -3779,7 +3660,7 @@
 	)
        (t
 	(setq xs (string-match "\\.xs$" file))
-	(cond ((eq erase 'ignore) (goto-char (point-max)))
+	(cond ((eq erase 'ignore) nil)
 	      (erase (erase-buffer))
 	      (t
 	       (goto-char 1)
@@ -3790,13 +3671,12 @@
 				    (progn 
 				      (forward-char 1)
 				      (search-forward "\f\n" nil 'toend)
-				      (point))))
-		 (goto-char (point-max)))))
+				      (point)))
+		     (goto-char 1)))))
 	(insert (cperl-find-tags file xs))))
       (if inbuffer nil		; Delegate to the caller
 	(save-buffer 0)		; No backup
-	(if (fboundp 'initialize-new-tags-table) ; Do we need something special in XEmacs?
-	    (initialize-new-tags-table))))))
+	(initialize-new-tags-table)))))
 
 (defvar cperl-tags-hier-regexp-list
   "^\\(\\(package\\)\\>\\|sub\\>[^\n]+::\\|[a-zA-Z_][a-zA-Z_0-9:]*(\C-?[^\n]+::\\|[ \t]*BOOT:\C-?[^\n]+::\\)")
@@ -4091,12 +3971,11 @@
   ;;(concat "\\("
   (mapconcat
    'identity
-   '("[$@%*&][0-9a-zA-Z_:]+\\([ \t]*[[{]\\)?"		; Usual variable
+   '("[$@%*&][0-9a-zA-Z_:]+"		; Usual variable
      "[$@]\\^[a-zA-Z]"			; Special variable
      "[$@][^ \n\t]"			; Special variable
      "-[a-zA-Z]"			; File test
      "\\\\[a-zA-Z0]"			; Special chars
-     "^=[a-z][a-zA-Z0-9_]*"		; Pod sections
      "[-!&*+,-./<=>?\\\\^|~]+"		; Operator
      "[a-zA-Z_0-9:]+"			; symbol or number
      "x="
@@ -4110,58 +3989,6 @@
   "Matches places in the buffer we can find help for.")
 
 (defvar cperl-message-on-help-error t)
-(defvar cperl-help-from-timer nil)
-
-(defun cperl-word-at-point-hard ()
-  ;; Does not save-excursion
-  ;; Get to the something meaningful
-  (or (eobp) (eolp) (forward-char 1))
-  (re-search-backward "[-a-zA-Z0-9_:!&*+,-./<=>?\\\\^|~$%@]" 
-		      (save-excursion (beginning-of-line) (point))
-		      'to-beg)
-  ;;  (cond
-  ;;   ((or (eobp) (looking-at "[][ \t\n{}();,]")) ; Not at a symbol
-  ;;    (skip-chars-backward " \n\t\r({[]});,")
-  ;;    (or (bobp) (backward-char 1))))
-  ;; Try to backtrace
-  (cond
-   ((looking-at "[a-zA-Z0-9_:]")	; symbol
-    (skip-chars-backward "[a-zA-Z0-9_:]")
-    (cond 
-     ((and (eq (preceding-char) ?^)	; $^I
-	   (eq (char-after (- (point) 2)) ?\$))
-      (forward-char -2))
-     ((memq (preceding-char) (append "*$@%&\\" nil)) ; *glob
-      (forward-char -1))
-     ((and (eq (preceding-char) ?\=)
-	   (eq (current-column) 1))
-      (forward-char -1)))		; =head1
-    (if (and (eq (preceding-char) ?\<)
-	     (looking-at "\\$?[a-zA-Z0-9_:]+>")) ; <FH>
-	(forward-char -1)))
-   ((and (looking-at "=") (eq (preceding-char) ?x)) ; x=
-    (forward-char -1))
-   ((and (looking-at "\\^") (eq (preceding-char) ?\$)) ; $^I
-    (forward-char -1))
-   ((looking-at "[-!&*+,-./<=>?\\\\^|~]")
-    (skip-chars-backward "[-!&*+,-./<=>?\\\\^|~]")
-    (cond
-     ((and (eq (preceding-char) ?\$)
-	   (not (eq (char-after (- (point) 2)) ?\$))) ; $-
-      (forward-char -1))
-     ((and (eq (following-char) ?\>)
-	   (string-match "[a-zA-Z0-9_]" (char-to-string (preceding-char)))
-	   (save-excursion
-	     (forward-sexp -1)
-	     (and (eq (preceding-char) ?\<)
-		  (looking-at "\\$?[a-zA-Z0-9_:]+>")))) ; <FH>
-      (search-backward "<"))))
-   ((and (eq (following-char) ?\$)
-	 (eq (preceding-char) ?\<)
-	 (looking-at "\\$?[a-zA-Z0-9_:]+>")) ; <$fh>
-    (forward-char -1)))
-  (if (looking-at cperl-have-help-regexp)
-      (buffer-substring (match-beginning 0) (match-end 0))))
 
 (defun cperl-get-help ()
   "Get one-line docs on the symbol at the point.
@@ -4169,19 +3996,56 @@
 than a line. Your contribution to update/shorten it is appreciated."
   (interactive)
   (save-excursion
-    (let ((word (cperl-word-at-point-hard)))
-      (if word
-	  (if (and cperl-help-from-timer ; Bail out if not in mainland
-		   (not (string-match "^#!\\|\\\\\\|^=" word)) ; Show help even in comments/strings.
-		   (or (memq (get-text-property (point) 'face)
-			     '(font-lock-comment-face font-lock-string-face))
-		       (memq (get-text-property (point) 'syntax-type)
-			     '(pod here-doc format))))
-	      nil
-	    (cperl-describe-perl-symbol word))
-	(if cperl-message-on-help-error
-	    (message "Nothing found for %s..." 
-		     (buffer-substring (point) (+ 5 (point)))))))))
+    ;; Get to the something meaningful
+    (or (eobp) (eolp) (forward-char 1))
+    (re-search-backward "[-a-zA-Z0-9_:!&*+,-./<=>?\\\\^|~$%@]" 
+			(save-excursion (beginning-of-line) (point))
+			'to-beg)
+    ;;  (cond
+    ;;   ((or (eobp) (looking-at "[][ \t\n{}();,]")) ; Not at a symbol
+    ;;    (skip-chars-backward " \n\t\r({[]});,")
+    ;;    (or (bobp) (backward-char 1))))
+    ;; Try to backtrace
+    (cond
+     ((looking-at "[a-zA-Z0-9_:]")	; symbol
+      (skip-chars-backward "[a-zA-Z0-9_:]")
+      (cond 
+       ((and (eq (preceding-char) ?^)	; $^I
+	     (eq (char-after (- (point) 2)) ?\$))
+	(forward-char -2))
+       ((memq (preceding-char) (append "*$@%&\\" nil)) ; *glob
+	(forward-char -1)))
+      (if (and (eq (preceding-char) ?\<)
+	       (looking-at "\\$?[a-zA-Z0-9_:]+>")) ; <FH>
+	  (forward-char -1)))
+     ((and (looking-at "=") (eq (preceding-char) ?x)) ; x=
+      (forward-char -1))
+     ((and (looking-at "\\^") (eq (preceding-char) ?\$)) ; $^I
+      (forward-char -1))
+     ((looking-at "[-!&*+,-./<=>?\\\\^|~]")
+      (skip-chars-backward "[-!&*+,-./<=>?\\\\^|~]")
+      (cond
+       ((and (eq (preceding-char) ?\$)
+	       (not (eq (char-after (- (point) 2)) ?\$))) ; $-
+	  (forward-char -1))
+       ((and (eq (following-char) ?\>)
+	     (string-match "[a-zA-Z0-9_]" (char-to-string (preceding-char)))
+	     (save-excursion
+	       (forward-sexp -1)
+	       (and (eq (preceding-char) ?\<)
+		    (looking-at "\\$?[a-zA-Z0-9_:]+>")))) ; <FH>
+	(search-backward "<"))))
+     ((and (eq (following-char) ?\$)
+	   (eq (preceding-char) ?\<)
+	   (looking-at "\\$?[a-zA-Z0-9_:]+>")) ; <$fh>
+      (forward-char -1)))
+    ;;(or (eobp) (forward-char 1))
+    (if (looking-at cperl-have-help-regexp)
+	(cperl-describe-perl-symbol 
+	 (buffer-substring (match-beginning 0) (match-end 0)))
+      (if cperl-message-on-help-error
+	  (message "Nothing found for %s..." 
+		   (buffer-substring (point) (+ 5 (point))))))))
 
 ;;; Stolen from perl-descr.el by Johan Vromans:
 
@@ -4190,27 +4054,46 @@
 
 (defun cperl-describe-perl-symbol (val)
   "Display the documentation of symbol at point, a Perl operator."
-  (let ((enable-recursive-minibuffers t)
+  ;; We suppose that the current position is at the start of the symbol
+  ;; when we convert $_[5] to @_
+  (let (;;(fn (perl-symbol-at-point))
+	(enable-recursive-minibuffers t)
+	;;val 
 	args-file regexp)
+    ;;  (interactive
+    ;;    (let ((fn (perl-symbol-at-point))
+    ;;	  (enable-recursive-minibuffers t)
+    ;;	  val args-file regexp)
+    ;;      (setq val (read-from-minibuffer
+    ;;		  (if fn
+    ;;		      (format "Symbol (default %s): " fn)
+    ;;		    "Symbol: ")))
+    ;;      (if (string= val "")
+    ;;	  (setq val fn))
     (cond
 	((string-match "^[&*][a-zA-Z_]" val)
 	 (setq val (concat (substring val 0 1) "NAME")))
-	((string-match "^[$@]\\([a-zA-Z_:0-9]+\\)[ \t]*\\[" val)
-	 (setq val (concat "@" (substring val 1 (match-end 1)))))
-	((string-match "^[$@]\\([a-zA-Z_:0-9]+\\)[ \t]*{" val)
-	 (setq val (concat "%" (substring val 1 (match-end 1)))))
-	((and (string= val "x") (string-match "^x=" val))
+	((looking-at "[$@][a-zA-Z_:0-9]+\\([[{]\\)")
+	 (if (= ?\[ (char-after (match-beginning 1)))
+	      (setq val (concat "@" (substring val 1)))
+	    (setq val (concat "%" (substring val 1)))))
+	((and (string= val "x") (looking-at "x="))
 	 (setq val "x="))
 	((string-match "^\\$[\C-a-\C-z]" val)
 	 (setq val (concat "$^" (char-to-string (+ ?A -1 (aref val 1))))))
-        ((string-match "^CORE::" val)
-	 (setq val "CORE::"))
-        ((string-match "^SUPER::" val)
-	 (setq val "SUPER::"))
-	((and (string= "<" val) (string-match "^<\\$?[a-zA-Z0-9_:]+>" val))
+	((and (string= "<" val) (looking-at "<\\$?[a-zA-Z0-9_:]+>"))
 	 (setq val "<NAME>")))
-    (setq regexp (concat "^" 
-			 "\\([^a-zA-Z0-9_:]+[ \t]+\\)?"
+;;;    (if (string-match "^[&*][a-zA-Z_]" val)
+;;;	(setq val (concat (substring val 0 1) "NAME"))
+;;;      (if (looking-at "[$@][a-zA-Z_:0-9]+\\([[{]\\)")
+;;;	  (if (= ?\[ (char-after (match-beginning 1)))
+;;;	      (setq val (concat "@" (substring val 1)))
+;;;	    (setq val (concat "%" (substring val 1))))
+;;;	(if (and (string= val "x") (looking-at "x="))
+;;;	    (setq val "x=")
+;;;	  (if (looking-at "[$@][a-zA-Z_:0-9]")
+;;;	      ))))
+    (setq regexp (concat "^" "\\([^a-zA-Z0-9_:]+[ \t]\\)?"
 			 (regexp-quote val) 
 			 "\\([ \t([/]\\|$\\)"))
 
@@ -4231,15 +4114,14 @@
 	     (message "No definition for %s" val)))))))
 
 (defvar cperl-short-docs "Ignore my value"
-  ;; Perl4 version was written by Johan Vromans (jvromans@squirrel.nl)
   "# based on '@(#)@ perl-descr.el 1.9 - describe-perl-symbol' [Perl 5]
-! ...	Logical negation.	
-... != ...	Numeric inequality.
-... !~ ...	Search pattern, substitution, or translation (negated).
+!	Logical negation.	
+!=	Numeric inequality.
+!~	Search pattern, substitution, or translation (negated).
 $!	In numeric context: errno. In a string context: error string.
 $\"	The separator which joins elements of arrays interpolated in strings.
 $#	The output format for printed numbers. Initial value is %.20g.
-$$	Process number of this script. Changes in the fork()ed child process.
+$$	The process number of the perl running this script. Altered (in the child process) by fork().
 $%	The current page number of the currently selected output channel.
 
 	The following variables are always local to the current block:
@@ -4265,9 +4147,9 @@
 $-	The number of lines left on the page.
 $.	The current input line number of the last filehandle that was read.
 $/	The input record separator, newline by default.
-$0	Name of the file containing the perl script being executed. May be set.
-$:     String may be broken after these characters to fill ^-lines in a format.
-$;	Subscript separator for multi-dim array emulation. Default \"\\034\".
+$0	The name of the file containing the perl script being executed. May be set
+$:	The set of characters after which a string may be broken to fill continuation fields (starting with ^) in a format.
+$;	The subscript separator for multi-dimensional array emulation. Default is \"\\034\".
 $<	The real uid of this process.
 $=	The page length of the current output channel. Default is 60 lines.
 $>	The effective uid of this process.
@@ -4291,28 +4173,28 @@
 $^W	True if warnings are requested (perl -w flag).
 $^X	The name under which perl was invoked (argv[0] in C-speech).
 $_	The default input and pattern-searching space.
-$|	Auto-flush after write/print on the current output channel? Default 0. 
+$|	Flag for auto-flush after write/print on the currently selected output channel. Default is 0. 
 $~	The name of the current report format.
-... % ...	Modulo division.
-... %= ...	Modulo division assignment.
+%	Modulo division.
+%=	Modulo division assignment.
 %ENV	Contains the current environment.
 %INC	List of files that have been require-d or do-ne.
 %SIG	Used to set signal handlers for various signals.
-... & ...	Bitwise and.
-... && ...	Logical and.
-... &&= ...	Logical and assignment.
-... &= ...	Bitwise and assignment.
-... * ...	Multiplication.
-... ** ...	Exponentiation.
-*NAME	Glob: all objects refered by NAME. *NAM1 = *NAM2 aliases NAM1 to NAM2.
+&	Bitwise and.
+&&	Logical and.
+&&=	Logical and assignment.
+&=	Bitwise and assignment.
+*	Multiplication.
+**	Exponentiation.
+*NAME	Refers to all objects represented by NAME. *NAM1 = *NAM2 makes NAM1 a reference to NAM2.
 &NAME(arg0, ...)	Subroutine call. Arguments go to @_.
-... + ...	Addition.		+EXPR	Makes EXPR into scalar context.
-++	Auto-increment (magical on strings).	++EXPR	EXPR++
-... += ...	Addition assignment.
++	Addition.
+++	Auto-increment (magical on strings).
++=	Addition assignment.
 ,	Comma operator.
-... - ...	Subtraction.
---	Auto-decrement (NOT magical on strings).	--EXPR	EXPR--
-... -= ...	Subtraction assignment.
+-	Subtraction.
+--	Auto-decrement.
+-=	Subtraction assignment.
 -A	Access time in days since script started.
 -B	File is a non-text (binary) file.
 -C	Inode change time in days since script started.
@@ -4343,54 +4225,54 @@
 .	Concatenate strings.
 ..	Alternation, also range operator.
 .=	Concatenate assignment strings
-... / ...	Division.	/PATTERN/ioxsmg	Pattern match
-... /= ...	Division assignment.
+/	Division.	/PATTERN/ioxsmg	Pattern match
+/=	Division assignment.
 /PATTERN/ioxsmg	Pattern match.
-... < ...	Numeric less than.	<pattern>	Glob.	See <NAME>, <> as well.
+<	Numeric less than.	<pattern>	Glob.	See <NAME>, <> as well.
 <NAME>	Reads line from filehandle NAME. NAME must be bareword/dollar-bareword.
 <pattern>	Glob. (Unless pattern is bareword/dollar-bareword - see <NAME>)
 <>	Reads line from union of files in @ARGV (= command line) and STDIN.
-... << ...	Bitwise shift left.	<<	start of HERE-DOCUMENT.
-... <= ...	Numeric less than or equal to.
-... <=> ...	Numeric compare.
-... = ...	Assignment.
-... == ...	Numeric equality.
-... =~ ...	Search pattern, substitution, or translation
-... > ...	Numeric greater than.
-... >= ...	Numeric greater than or equal to.
-... >> ...	Bitwise shift right.
-... >>= ...	Bitwise shift right assignment.
-... ? ... : ...	Condition=if-then-else operator.   ?PAT? One-time pattern match.
-?PATTERN?	One-time pattern match.
+<<	Bitwise shift left.	<<	start of HERE-DOCUMENT.
+<=	Numeric less than or equal to.
+<=>	Numeric compare.
+=	Assignment.
+==	Numeric equality.
+=~	Search pattern, substitution, or translation
+>	Numeric greater than.
+>=	Numeric greater than or equal to.
+>>	Bitwise shift right.
+>>=	Bitwise shift right assignment.
+? :	Alternation (if-then-else) operator.	?PAT? Backwards pattern match.
+?PATTERN?	Backwards pattern match.
 @ARGV	Command line arguments (not including the command name - see $0).
 @INC	List of places to look for perl scripts during do/include/use.
 @_	Parameter array for subroutines. Also used by split unless in array context.
 \\	Creates a reference to whatever follows, like \$var.
 \\0	Octal char, e.g. \\033.
 \\E	Case modification terminator. See \\Q, \\L, and \\U.
-\\L	Lowercase until \\E . See also \l, lc.
-\\U	Upcase until \\E . See also \u, uc.
-\\Q	Quote metacharacters until \\E . See also quotemeta.
+\\L	Lowercase until \\E .
+\\U	Upcase until \\E .
+\\Q	Quote metacharacters until \\E .
 \\a	Alarm character (octal 007).
 \\b	Backspace character (octal 010).
 \\c	Control character, e.g. \\c[ .
 \\e	Escape character (octal 033).
 \\f	Formfeed character (octal 014).
-\\l	Lowercase the next character. See also \\L and \\u, lcfirst,
+\\l	Lowercase of next character. See also \\L and \\u,
 \\n	Newline character (octal 012).
 \\r	Return character (octal 015).
 \\t	Tab character (octal 011).
-\\u	Upcase the next character. See also \\U and \\l, ucfirst,
+\\u	Upcase  of next character. See also \\U and \\l,
 \\x	Hex character, e.g. \\x1b.
-^ ...	Bitwise exclusive or.
-__END__	Ends program source.
-__DATA__	Ends program source.
+^	Bitwise exclusive or.
+__END__	End of program source.
+__DATA__	End of program source.
 __FILE__	Current (source) filename.
 __LINE__	Current line in current source.
 ARGV	Default multi-file input filehandle. <ARGV> is a synonym for <>.
 ARGVOUT	Output filehandle with -i flag.
-BEGIN { ... }	Immediately executed (during compilation) piece of code.
-END { ... }	Pseudo-subroutine executed after the script finishes.
+BEGIN { block }	Immediately executed (during compilation) piece of code.
+END { block }	Pseudo-subroutine executed after the script finishes.
 DATA	Input filehandle for what follows after __END__	or __DATA__.
 accept(NEWSOCKET,GENERICSOCKET)
 alarm(SECONDS)
@@ -4405,20 +4287,20 @@
 chroot(FILENAME)
 close(FILEHANDLE)
 closedir(DIRHANDLE)
-... cmp ...	String compare.
+cmp	String compare.
 connect(SOCKET,NAME)
 continue of { block } continue { block }. Is executed after `next' or at end.
 cos(EXPR)
 crypt(PLAINTEXT,SALT)
-dbmclose(%HASH)
-dbmopen(%HASH,DBNAME,MODE)
+dbmclose(ASSOC_ARRAY)
+dbmopen(ASSOC,DBNAME,MODE)
 defined(EXPR)
-delete($HASH{KEY})
+delete($ASSOC{KEY})
 die(LIST)
 do { ... }|SUBR while|until EXPR	executes at least once
 do(EXPR|SUBR([LIST]))
 dump LABEL
-each(%HASH)
+each(ASSOC_ARRAY)
 endgrent
 endhostent
 endnetent
@@ -4426,7 +4308,7 @@
 endpwent
 endservent
 eof[([FILEHANDLE])]
-... eq ...	String equality.
+eq	String equality.
 eval(EXPR) or eval { BLOCK }
 exec(LIST)
 exit(EXPR)
@@ -4437,7 +4319,7 @@
 for (EXPR;EXPR;EXPR) { ... }
 foreach [VAR] (@ARRAY) { ... }
 fork
-... ge ...	String greater than or equal.
+ge	String greater than or equal.
 getc[(FILEHANDLE)]
 getgrent
 getgrgid(GID)
@@ -4467,17 +4349,17 @@
 gmtime(EXPR)
 goto LABEL
 grep(EXPR,LIST)
-... gt ...	String greater than.
+gt	String greater than.
 hex(EXPR)
 if (EXPR) { ... } [ elsif (EXPR) { ... } ... ] [ else { ... } ] or EXPR if EXPR
 index(STR,SUBSTR[,OFFSET])
 int(EXPR)
 ioctl(FILEHANDLE,FUNCTION,SCALAR)
 join(EXPR,LIST)
-keys(%HASH)
+keys(ASSOC_ARRAY)
 kill(LIST)
 last [LABEL]
-... le ...	String less than or equal.
+le	String less than or equal.
 length(EXPR)
 link(OLDFILE,NEWFILE)
 listen(SOCKET,QUEUESIZE)
@@ -4485,7 +4367,7 @@
 localtime(EXPR)
 log(EXPR)
 lstat(EXPR|FILEHANDLE|VAR)
-... lt ...	String less than.
+lt	String less than.
 m/PATTERN/iogsmx
 mkdir(FILENAME,MODE)
 msgctl(ID,CMD,ARG)
@@ -4493,14 +4375,14 @@
 msgrcv(ID,VAR,SIZE,TYPE.FLAGS)
 msgsnd(ID,MSG,FLAGS)
 my VAR or my (VAR1,...)	Introduces a lexical variable ($VAR, @ARR, or %HASH).
-... ne ...	String inequality.
+ne	String inequality.
 next [LABEL]
 oct(EXPR)
 open(FILEHANDLE[,EXPR])
 opendir(DIRHANDLE,EXPR)
 ord(EXPR)
 pack(TEMPLATE,LIST)
-package NAME	Introduces package context.
+package	Introduces package context.
 pipe(READHANDLE,WRITEHANDLE)
 pop(ARRAY)
 print [FILEHANDLE] [(LIST)]
@@ -4559,7 +4441,7 @@
 srand(EXPR)
 stat(EXPR|FILEHANDLE|VAR)
 study[(SCALAR)]
-sub [NAME [(format)]] { BODY }	sub NAME [(format)];	sub [(format)] {...}
+sub [NAME [(format)]] { BODY }	or	sub [NAME [(format)]];
 substr(EXPR,OFFSET[,LEN])
 symlink(OLDFILE,NEWFILE)
 syscall(LIST)
@@ -4578,73 +4460,23 @@
 unlink(LIST)
 unpack(TEMPLATE,EXPR)
 unshift(ARRAY,LIST)
-until (EXPR) { ... }					EXPR until EXPR
+until (EXPR) { ... } or EXPR until EXPR
 utime(LIST)
-values(%HASH)
+values(ASSOC_ARRAY)
 vec(EXPR,OFFSET,BITS)
 wait
 waitpid(PID,FLAGS)
 wantarray
 warn(LIST)
-while  (EXPR) { ... }					EXPR while EXPR
+while  (EXPR) { ... } or EXPR while EXPR
 write[(EXPR|FILEHANDLE)]
-... x ...	Repeat string or array.
-x= ...	Repetition assignment.
+x	Repeat string or array.
+x=	Repetition assignment.
 y/SEARCHLIST/REPLACEMENTLIST/
-... | ...	Bitwise or.
-... || ...	Logical or.
-~ ...		Unary bitwise complement.
+|	Bitwise or.
+||	Logical or.
+~	Unary bitwise complement.
 #!	OS interpreter indicator. If contains `perl', used for options, and -x.
-AUTOLOAD {...}	Shorthand for `sub AUTOLOAD {...}'.
-CORE::		Prefix to access builtin function if imported sub obscures it.
-SUPER::		Prefix to lookup for a method in @ISA classes.
-DESTROY		Shorthand for `sub DESTROY {...}'.
-... EQ ...	Obsolete synonym of `eq'.
-... GE ...	Obsolete synonym of `ge'.
-... GT ...	Obsolete synonym of `gt'.
-... LE ...	Obsolete synonym of `le'.
-... LT ...	Obsolete synonym of `lt'.
-... NE ...	Obsolete synonym of `ne'.
-abs [ EXPR ]	absolute value
-... and ...		Low-precedence synonym for &&.
-bless REFERENCE [, PACKAGE]	Makes reference into an object of a package.
-chomp		Docs missing
-chr		Docs missing
-else		Part of if/unless {BLOCK} elsif {BLOCK} else {BLOCK}.
-elsif		Part of if/unless {BLOCK} elsif {BLOCK} else {BLOCK}.
-exists	$HASH{KEY}	True if the key exists.
-format		Docs missing
-formline	Docs missing
-glob EXPR	Synonym of <EXPR>.
-lc [ EXPR ]	Returns lowercased EXPR.
-lcfirst [ EXPR ]	Returns EXPR with lower-cased first letter.
-map		Docs missing
-no PACKAGE [SYMBOL1, ...]  Partial reverse for `use'. Runs `unimport' method.
-... not ...		Low-precedence synonym for ! - negation.
-... or ...		Low-precedence synonym for ||.
-pos STRING    Set/Get end-position of the last match over this string, see \\G.
-quotemeta [ EXPR ]	Quote metacharacters.
-qw		Docs missing
-readline FH	Synonym of <FH>.
-readpipe CMD	Synonym of `CMD`.
-ref [ EXPR ]	Type of EXPR when dereferenced.
-sysopen		Docs missing
-tie		Docs missing
-tied		Docs missing
-uc [ EXPR ]	Returns upcased EXPR.
-ucfirst [ EXPR ]	Returns EXPR with upcased first letter.
-untie		Docs missing
-use PACKAGE [SYMBOL1, ...]  Compile-time `require' with consequent `import'.
-... xor ...		Low-precedence synonym for exclusive or.
-prototype \&SUB	Returns prototype of the function given a reference.
-=head1		Top-level heading.
-=head2		Second-level heading.
-=head3		Third-level heading (is there such?).
-=over [ NUMBER ]	Start list.
-=item [ TITLE ]		Start new item in the list.
-=back		End list.
-=cut		Switch from POD to Perl.
-=pod		Switch from Perl to POD.
 ")
 
 (defun cperl-switch-to-doc-buffer ()
@@ -4690,7 +4522,7 @@
 
       (defun cperl-get-help-defer ()
 	(if (not (eq major-mode 'perl-mode)) nil
-	  (let ((cperl-message-on-help-error nil) (cperl-help-from-timer t))
+	  (let ((cperl-message-on-help-error nil))
 	    (cperl-get-help)
 	    (setq cperl-help-shown t))))
       (cperl-lazy-install)))