xemacs-beta: lisp/modes/cperl-mode.el comparison

comparison 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

comparison

equal deleted inserted replaced

-:804d1389bcd6
+:131b0175ea99
 ;;; 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:
 ;; (autoload 'perl-mode "cperl-mode" "alternate mode for editing Perl programs" t)
 ;; (setq cperl-hairy t)
 ;;; 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
 ;;       (append '(("\\.[pP][Llm]$" . perl-mode))  auto-mode-alist ))
 ;;;  comments and docstrings corrected, XEmacs support cleaned up.
 ;;;  The closing parenths would enclose the region into matching
 ;;;  parens under the same conditions as the opening ones.
 ;;;  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:
 (defvar cperl-electric-lbrace-space nil
 "*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
 "*Non-nil (and non-null) means parentheses should be electric in CPerl.
 Can be overwritten by `cperl-hairy' if nil.")
 (defvar cperl-imenu-addback nil
 "*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'.")
 *cannot* match parentheses in Perl 100% correctly. So
 	1 if s#//#/#;
 will not break indentation, but
 	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:
 a) Check what Emacs thinks about balance of your parentheses.
 			  (skip-chars-backward " \t")
 			  (eq (preceding-char) ?\))))
 		   (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)
 		  (cperl-indent-line)))
 	    (save-excursion
 "Insert a matching pair of parentheses if marking is active.
 If not, or if we are not at the end of marking range, would self-insert."
 (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)
 		     nil))
 	p)
 	     (search
 	      (concat
 	       "\\(\\`\n?\\|\n\n\\)="
 	       "\\|"
 	       ;; One extra () before this:
-	       "<<"
+	       "<<\\(\\([\"'`]\\)\\([^\"'`\n]*\\)\\3\\|\\(\\([a-zA-Z_][a-zA-Z_0-9]*\\)?\\)[^=]\\)" ; [^=] to avoid <<=.
-	         "\\("
-		 ;; 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$@%&]\\)"
-		 "\\)"
 	       "\\|"
-	       ;; 1+6 extra () before this:
+	       ;; 1+5 extra () before this:
 	       "^[ \t]*format[ \t]*\\([a-zA-Z0-9_]+\\)?[ \t]*=[ \t]*$")))
 (unwind-protect
 	(progn
 	  (save-excursion
 	    (message "Scanning for pods, formats and here-docs...")
 					    'syntax-type 'here-doc)
 			 (cperl-put-do-not-fontify b (match-beginning 0)))
 			(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
+		      name (if (match-beginning 7) ; 6 + 1
-			       (buffer-substring (match-beginning 8) ; 7 + 1
+			       (buffer-substring (match-beginning 7) ; 6 + 1
-						 (match-end 8)) ; 7 + 1
+						 (match-end 7)) ; 6 + 1
 			     ""))
 		(setq argument nil)
 		(if cperl-pod-here-fontify
 		    (while (and (eq (forward-line) 0)
 				(not (looking-at "^[.;]$")))
 (interactive)
 (require 'mode-compile)
 (let ((perl-dbg-flags "-wc"))
 (mode-compile)))
-(defun cperl-info-buffer (type)
+(defun cperl-info-buffer ()
-;; Returns buffer with documentation. Creates if missing.
+;; Returns buffer with documentation. Creates if missing
-;; If TYPE, this vars buffer.
+(let ((info (get-buffer "*info-perl*")))
-;; 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*")))
 (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)
+	(rename-buffer "*info-perl*")
-	(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)
 	(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)
+(require 'etags)
-	(progn
+(funcall (or (and (boundp 'find-tag-default-function)
-	  (require 'etags)
+		      find-tag-default-function)
-	  (funcall (or (and (boundp 'find-tag-default-function)
+		 (get major-mode 'find-tag-default-function)
-			    find-tag-default-function)
+		 ;; XEmacs 19.12 has `find-tag-default-hook'; it is
-		       (get major-mode 'find-tag-default-function)
+		 ;; automatically used within `find-tag-default':
-		       ;; XEmacs 19.12 has `find-tag-default-hook'; it is
+		 'find-tag-default))))
-		       ;; automatically used within `find-tag-default':
-		       'find-tag-default))))))
 (defun cperl-info-on-command (command)
-"Shows documentation for Perl command in other window.
+"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'."
 (interactive
 (let* ((default (cperl-word-at-point))
 	  (read (read-string
 		     (format "Find doc for Perl function (default %s): "
 			     default))))
 		   default
 		 read))))
 (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
+	pos)
-	max-height char-height buf-list)
 (if (string-match "^-[a-zA-Z]$" command)
 	(setq cmd-desc "^-X[ \t\n]"))
-(setq isvar (string-match "^[$@%]" command)
+(set-buffer (cperl-info-buffer))
-	  buf (cperl-info-buffer isvar)
-	  iniwin (selected-window)
-	  fr1 (window-frame iniwin))
-(set-buffer buf)
 (beginning-of-buffer)
-(or isvar
+(re-search-forward "^-X[ \t\n]")
-	(progn (re-search-forward "^-X[ \t\n]")
+(forward-line -1)
-	       (forward-line -1)))
 (if (re-search-forward cmd-desc nil t)
 	(progn
-	  ;; Go back to beginning of the group (ex, for qq)
+	  (setq pos (progn (beginning-of-line)
-	  (if (re-search-backward "^[ \t\n\f]")
+			   (point)))
-	      (forward-line 1))
+	  (pop-to-buffer (cperl-info-buffer))
-	  (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)))))
 	  (set-window-start (selected-window) pos))
 (message "No entry for %s found." command))
-;;(pop-to-buffer buffer)
+(pop-to-buffer buffer)))
-(select-window iniwin)))
 (defun cperl-info-on-current-command ()
 "Shows documentation for Perl command at point in other window."
 (interactive)
 (cperl-info-on-command (cperl-word-at-point)))
 	 imenu-create-index-function
 	 imenu-prev-index-position-function
 	 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
 			       'cperl-imenu-info-imenu-search
 			       imenu-extract-index-name-function
 			       (t (cperl-write-tags file erase recurse t t)))))
 		  files))
 	)
 (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)
 	       (if (search-forward (concat "\f\n" file ",") nil t)
 		   (progn
 		     (search-backward "\f\n")
 		     (delete-region (point)
 				    (progn
 				      (forward-char 1)
 				      (search-forward "\f\n" nil 'toend)
-				      (point))))
+				      (point)))
-		 (goto-char (point-max)))))
+		     (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]+::\\)")
 (defvar cperl-hierarchy '(() ())
 ;;; Getting help
 (defvar cperl-have-help-regexp
 ;;(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="
 "#!"
 )
 	  ;;"\\)"
 	  ;;)
 "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.
 The data for these docs is a little bit obsolete and may be in fact longer
 than a line. Your contribution to update/shorten it is appreciated."
 (interactive)
 (save-excursion
-(let ((word (cperl-word-at-point-hard)))
+;; Get to the something meaningful
-(if word
+(or (eobp) (eolp) (forward-char 1))
-	  (if (and cperl-help-from-timer ; Bail out if not in mainland
+(re-search-backward "[-a-zA-Z0-9_:!&*+,-./<=>?\\\\^|~$%@]"
-		   (not (string-match "^#!\\|\\\\\\|^=" word)) ; Show help even in comments/strings.
+			(save-excursion (beginning-of-line) (point))
-		   (or (memq (get-text-property (point) 'face)
+			'to-beg)
-			     '(font-lock-comment-face font-lock-string-face))
+;;  (cond
-		       (memq (get-text-property (point) 'syntax-type)
+;;   ((or (eobp) (looking-at "[][ \t\n{}();,]")) ; Not at a symbol
-			     '(pod here-doc format))))
+;;    (skip-chars-backward " \n\t\r({[]});,")
-	      nil
+;;    (or (bobp) (backward-char 1))))
-	    (cperl-describe-perl-symbol word))
+;; Try to backtrace
-	(if cperl-message-on-help-error
+(cond
-	    (message "Nothing found for %s..."
+((looking-at "[a-zA-Z0-9_:]")	; symbol
-		     (buffer-substring (point) (+ 5 (point)))))))))
+(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:
 (defvar cperl-doc-buffer " *perl-doc*"
 "Where the documentation can be found.")
 (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)
+	((looking-at "[$@][a-zA-Z_:0-9]+\\([[{]\\)")
-	 (setq val (concat "@" (substring val 1 (match-end 1)))))
+	 (if (= ?\[ (char-after (match-beginning 1)))
-	((string-match "^[$@]\\([a-zA-Z_:0-9]+\\)[ \t]*{" val)
+	      (setq val (concat "@" (substring val 1)))
-	 (setq val (concat "%" (substring val 1 (match-end 1)))))
+	    (setq val (concat "%" (substring val 1)))))
-	((and (string= val "x") (string-match "^x=" val))
+	((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)
+	((and (string= "<" val) (looking-at "<\\$?[a-zA-Z0-9_:]+>"))
-	 (setq val "CORE::"))
-((string-match "^SUPER::" val)
-	 (setq val "SUPER::"))
-	((and (string= "<" val) (string-match "^<\\$?[a-zA-Z0-9_:]+>" val))
 	 (setq val "<NAME>")))
-(setq regexp (concat "^"
+;;;    (if (string-match "^[&*][a-zA-Z_]" val)
-			 "\\([^a-zA-Z0-9_:]+[ \t]+\\)?"
+;;;	(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([/]\\|$\\)"))
 ;; get the buffer with the documentation text
 (cperl-switch-to-doc-buffer)
 	       (message "%s" (buffer-substring lnstart (point)))))
 	 (if cperl-message-on-help-error
 	     (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.
+!	Logical negation.
-... != ...	Numeric inequality.
+!=	Numeric inequality.
-... !~ ...	Search pattern, substitution, or translation (negated).
+!~	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:
 $1	Match of the 1st set of parentheses in the last match (auto-local).
 $+	The last bracket matched by the last search pattern.
 $,	The output field separator for the print operator.
 $-	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.
+$0	The 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.
+$:	The set of characters after which a string may be broken to fill continuation fields (starting with ^) in a format.
-$;	Subscript separator for multi-dim array emulation. Default \"\\034\".
+$;	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.
 $?	The status returned by the last ``, pipe close or `system'.
 $@	The perl error message from the last eval or do @var{EXPR} command.
 $^P	Internal debugging flag.
 $^T	The time the script was started. Used by -A/-M/-C file tests.
 $^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.
-... %= ...	Modulo division assignment.
+%=	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.
+&	Bitwise and.
-... && ...	Logical and.
+&&	Logical and.
-... &&= ...	Logical and assignment.
+&&=	Logical and assignment.
-... &= ...	Bitwise and assignment.
+&=	Bitwise and assignment.
-... * ...	Multiplication.
+*	Multiplication.
-... ** ...	Exponentiation.
+**	Exponentiation.
-*NAME	Glob: all objects refered by NAME. *NAM1 = *NAM2 aliases NAM1 to NAM2.
+*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.
++	Addition.
-++	Auto-increment (magical on strings).	++EXPR	EXPR++
+++	Auto-increment (magical on strings).
-... += ...	Addition assignment.
++=	Addition assignment.
 ,	Comma operator.
-... - ...	Subtraction.
+-	Subtraction.
---	Auto-decrement (NOT magical on strings).	--EXPR	EXPR--
+--	Auto-decrement.
-... -= ...	Subtraction assignment.
+-=	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.
 -M	Age in days since script started.
 -O	File is owned by real uid.
 -x	File is executable by effective uid.
 -z	File has zero size.
 .	Concatenate strings.
 ..	Alternation, also range operator.
 .=	Concatenate assignment strings
-... / ...	Division.	/PATTERN/ioxsmg	Pattern match
+/	Division.	/PATTERN/ioxsmg	Pattern match
-... /= ...	Division assignment.
+/=	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.
+<<	Bitwise shift left.	<<	start of HERE-DOCUMENT.
-... <= ...	Numeric less than or equal to.
+<=	Numeric less than or equal to.
-... <=> ...	Numeric compare.
+<=>	Numeric compare.
-... = ...	Assignment.
+=	Assignment.
-... == ...	Numeric equality.
+==	Numeric equality.
-... =~ ...	Search pattern, substitution, or translation
+=~	Search pattern, substitution, or translation
-... > ...	Numeric greater than.
+>	Numeric greater than.
-... >= ...	Numeric greater than or equal to.
+>=	Numeric greater than or equal to.
-... >> ...	Bitwise shift right.
+>>	Bitwise shift right.
-... >>= ...	Bitwise shift right assignment.
+>>=	Bitwise shift right assignment.
-... ? ... : ...	Condition=if-then-else operator.   ?PAT? One-time pattern match.
+? :	Alternation (if-then-else) operator.	?PAT? Backwards pattern match.
-?PATTERN?	One-time 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.
+\\L	Lowercase until \\E .
-\\U	Upcase until \\E . See also \u, uc.
+\\U	Upcase until \\E .
-\\Q	Quote metacharacters until \\E . See also quotemeta.
+\\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.
+^	Bitwise exclusive or.
-__END__	Ends program source.
+__END__	End of program source.
-__DATA__	Ends 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.
+BEGIN { block }	Immediately executed (during compilation) piece of code.
-END { ... }	Pseudo-subroutine executed after the script finishes.
+END { block }	Pseudo-subroutine executed after the script finishes.
 DATA	Input filehandle for what follows after __END__	or __DATA__.
 accept(NEWSOCKET,GENERICSOCKET)
 alarm(SECONDS)
 atan2(X,Y)
 bind(SOCKET,NAME)
 chop[(LIST|VAR)]
 chown(LIST)
 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)
+dbmclose(ASSOC_ARRAY)
-dbmopen(%HASH,DBNAME,MODE)
+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
 endprotoent
 endpwent
 endservent
 eof[([FILEHANDLE])]
-... eq ...	String equality.
+eq	String equality.
 eval(EXPR) or eval { BLOCK }
 exec(LIST)
 exit(EXPR)
 exp(EXPR)
 fcntl(FILEHANDLE,FUNCTION,SCALAR)
 fileno(FILEHANDLE)
 flock(FILEHANDLE,OPERATION)
 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)
 getgrnam(NAME)
 gethostbyaddr(ADDR,ADDRTYPE)
 getsockname(SOCKET)
 getsockopt(SOCKET,LEVEL,OPTNAME)
 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)
 local(LIST)
 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)
 msgget(KEY,FLAGS)
 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)]
 printf [FILEHANDLE] (FORMAT,LIST)
 push(ARRAY,LIST)
 sprintf(FORMAT,LIST)
 sqrt(EXPR)
 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)
 sysread(FILEHANDLE,SCALAR,LENGTH[,OFFSET])
 system(LIST)
 undef[(EXPR)]
 unless (EXPR) { ... } [ else { ... } ] or EXPR unless EXPR
 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	Repeat string or array.
-x= ...	Repetition assignment.
+x=	Repetition assignment.
 y/SEARCHLIST/REPLACEMENTLIST/
-... | ...	Bitwise or.
+|	Bitwise or.
-... || ...	Logical or.
+||	Logical or.
-~ ...		Unary bitwise complement.
+~	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 ()
 "Go to the perl documentation buffer and insert the documentation."
 (interactive)
 (defun cperl-lazy-hook ()
 	(setq cperl-help-shown nil))
 (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)))

Mercurial > hg > xemacs-beta

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