[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] Changes to emacs/lisp/progmodes/cperl-mode.el
|
From: |
Stefan Monnier |
|
Subject: |
[Emacs-diffs] Changes to emacs/lisp/progmodes/cperl-mode.el |
|
Date: |
Sat, 22 Feb 2003 21:19:02 -0500 |
Index: emacs/lisp/progmodes/cperl-mode.el
diff -c emacs/lisp/progmodes/cperl-mode.el:1.42
emacs/lisp/progmodes/cperl-mode.el:1.43
*** emacs/lisp/progmodes/cperl-mode.el:1.42 Sat Feb 22 20:42:24 2003
--- emacs/lisp/progmodes/cperl-mode.el Sat Feb 22 21:19:02 2003
***************
*** 69,74 ****
--- 69,77 ----
;; Some macros are needed for `defcustom'
(eval-when-compile
+ (condition-case nil
+ (require 'man)
+ (error nil))
(defconst cperl-xemacs-p (string-match "XEmacs\\|Lucid" emacs-version))
(defvar cperl-can-font-lock
(or cperl-xemacs-p
***************
*** 120,127 ****
`(goto-line (string-to-int (elt ,elt 1))))
;;)
(defmacro cperl-etags-goto-tag-location (elt)
! `(etags-goto-tag-location ,elt)))
! (autoload 'tmm-prompt "tmm"))
(defconst cperl-xemacs-p (string-match "XEmacs\\|Lucid" emacs-version))
--- 123,129 ----
`(goto-line (string-to-int (elt ,elt 1))))
;;)
(defmacro cperl-etags-goto-tag-location (elt)
! `(etags-goto-tag-location ,elt))))
(defconst cperl-xemacs-p (string-match "XEmacs\\|Lucid" emacs-version))
***************
*** 321,326 ****
--- 323,333 ----
:type '(choice (const null) boolean)
:group 'cperl-affected-by-hairy)
+ (defcustom cperl-electric-backspace-untabify t
+ "*Not-nil means electric-backspace will untabify in CPerl."
+ :type 'boolean
+ :group 'cperl-autoinsert-details)
+
(defcustom cperl-hairy nil
"*Not-nil means most of the bells and whistles are enabled in CPerl.
Affects: `cperl-font-lock', `cperl-electric-lbrace-space',
***************
*** 335,342 ****
:type 'integer
:group 'cperl-indentation-details)
! (defcustom cperl-vc-header-alist '((SCCS "$sccs = '%W\%' ;")
! (RCS "$rcs = ' $Id\$ ' ;"))
"*What to use as `vc-header-alist' in CPerl."
:type '(repeat (list symbol string))
:group 'cperl)
--- 342,349 ----
:type 'integer
:group 'cperl-indentation-details)
! (defcustom cperl-vc-header-alist '((SCCS "($sccs) = ('%W\%' =~
/(\\d+(\\.\\d+)+)/) ;")
! (RCS "($rcs) = (' $Id\$ ' =~
/(\\d+(\\.\\d+)+)/) ;"))
"*What to use as `vc-header-alist' in CPerl."
:type '(repeat (list symbol string))
:group 'cperl)
***************
*** 1128,1184 ****
;;; ["Add tags for Perl files in (sub)directories"
;;; (cperl-etags t 'recursive) t])
;;;; cperl-write-tags (&optional file erase recurse dir inbuffer)
! ["Create tags for current file" (cperl-write-tags nil t) t]
! ["Add tags for current file" (cperl-write-tags) t]
! ["Create tags for Perl files in directory"
! (cperl-write-tags nil t nil t) t]
! ["Add tags for Perl files in directory"
! (cperl-write-tags nil nil nil t) t]
! ["Create tags for Perl files in (sub)directories"
! (cperl-write-tags nil t t t) t]
! ["Add tags for Perl files in (sub)directories"
! (cperl-write-tags nil nil t t) t]))
! ("Perl docs"
! ["Define word at point" imenu-go-find-at-position
! (fboundp 'imenu-go-find-at-position)]
! ["Help on function" cperl-info-on-command t]
! ["Help on function at point" cperl-info-on-current-command t]
! ["Help on symbol at point" cperl-get-help t]
! ["Perldoc" cperl-perldoc t]
! ["Perldoc on word at point" cperl-perldoc-at-point t]
! ["View manpage of POD in this file" cperl-pod-to-manpage t]
! ["Auto-help on" cperl-lazy-install
! (and (fboundp 'run-with-idle-timer)
! (not cperl-lazy-installed))]
! ["Auto-help off" (eval '(cperl-lazy-unstall))
! (and (fboundp 'run-with-idle-timer)
! cperl-lazy-installed)])
! ("Toggle..."
! ["Auto newline" cperl-toggle-auto-newline t]
! ["Electric parens" cperl-toggle-electric t]
! ["Electric keywords" cperl-toggle-abbrev t]
! ["Fix whitespace on indent" cperl-toggle-construct-fix t]
! ["Auto fill" auto-fill-mode t])
! ("Indent styles..."
! ["CPerl" (cperl-set-style "CPerl") t]
! ["PerlStyle" (cperl-set-style "PerlStyle") t]
! ["GNU" (cperl-set-style "GNU") t]
! ["C++" (cperl-set-style "C++") t]
! ["FSF" (cperl-set-style "FSF") t]
! ["BSD" (cperl-set-style "BSD") t]
! ["Whitesmith" (cperl-set-style "Whitesmith") t]
! ["Current" (cperl-set-style "Current") t]
! ["Memorized" (cperl-set-style-back) cperl-old-style])
! ("Micro-docs"
! ["Tips" (describe-variable 'cperl-tips) t]
! ["Problems" (describe-variable 'cperl-problems) t]
! ["Speed" (describe-variable 'cperl-speed) t]
! ["Praise" (describe-variable 'cperl-praise) t]
! ["Faces" (describe-variable 'cperl-tips-faces) t]
! ["CPerl mode" (describe-function 'cperl-mode) t]
! ["CPerl version"
! (message "The version of master-file for this CPerl is %s-emacs"
! cperl-version) t]))))
(error nil))
(autoload 'c-macro-expand "cmacexp"
--- 1135,1192 ----
;;; ["Add tags for Perl files in (sub)directories"
;;; (cperl-etags t 'recursive) t])
;;;; cperl-write-tags (&optional file erase recurse dir inbuffer)
! ["Create tags for current file" (cperl-write-tags nil t) t]
! ["Add tags for current file" (cperl-write-tags) t]
! ["Create tags for Perl files in directory"
! (cperl-write-tags nil t nil t) t]
! ["Add tags for Perl files in directory"
! (cperl-write-tags nil nil nil t) t]
! ["Create tags for Perl files in (sub)directories"
! (cperl-write-tags nil t t t) t]
! ["Add tags for Perl files in (sub)directories"
! (cperl-write-tags nil nil t t) t]))
! ("Perl docs"
! ["Define word at point" imenu-go-find-at-position
! (fboundp 'imenu-go-find-at-position)]
! ["Help on function" cperl-info-on-command t]
! ["Help on function at point" cperl-info-on-current-command t]
! ["Help on symbol at point" cperl-get-help t]
! ["Perldoc" cperl-perldoc t]
! ["Perldoc on word at point" cperl-perldoc-at-point t]
! ["View manpage of POD in this file" cperl-build-manpage t]
! ["Auto-help on" cperl-lazy-install
! (and (fboundp 'run-with-idle-timer)
! (not cperl-lazy-installed))]
! ["Auto-help off" cperl-lazy-unstall
! (and (fboundp 'run-with-idle-timer)
! cperl-lazy-installed)])
! ("Toggle..."
! ["Auto newline" cperl-toggle-auto-newline t]
! ["Electric parens" cperl-toggle-electric t]
! ["Electric keywords" cperl-toggle-abbrev t]
! ["Fix whitespace on indent" cperl-toggle-construct-fix t]
! ["Auto-help on Perl constructs" cperl-toggle-autohelp t]
! ["Auto fill" auto-fill-mode t])
! ("Indent styles..."
! ["CPerl" (cperl-set-style "CPerl") t]
! ["PerlStyle" (cperl-set-style "PerlStyle") t]
! ["GNU" (cperl-set-style "GNU") t]
! ["C++" (cperl-set-style "C++") t]
! ["FSF" (cperl-set-style "FSF") t]
! ["BSD" (cperl-set-style "BSD") t]
! ["Whitesmith" (cperl-set-style "Whitesmith") t]
! ["Current" (cperl-set-style "Current") t]
! ["Memorized" (cperl-set-style-back) cperl-old-style])
! ("Micro-docs"
! ["Tips" (describe-variable 'cperl-tips) t]
! ["Problems" (describe-variable 'cperl-problems) t]
! ["Speed" (describe-variable 'cperl-speed) t]
! ["Praise" (describe-variable 'cperl-praise) t]
! ["Faces" (describe-variable 'cperl-tips-faces) t]
! ["CPerl mode" (describe-function 'cperl-mode) t]
! ["CPerl version"
! (message "The version of master-file for this CPerl is %s-Emacs"
! cperl-version) t]))))
(error nil))
(autoload 'c-macro-expand "cmacexp"
***************
*** 1469,1475 ****
(make-local-variable 'comment-start-skip)
(setq comment-start-skip "#+ *")
(make-local-variable 'defun-prompt-regexp)
! (setq defun-prompt-regexp "^[ \t]*sub[ \t]+\\([^ \t\n{(;]+\\)[ \t]*")
(make-local-variable 'comment-indent-function)
(setq comment-indent-function 'cperl-comment-indent)
(make-local-variable 'parse-sexp-ignore-comments)
--- 1477,1483 ----
(make-local-variable 'comment-start-skip)
(setq comment-start-skip "#+ *")
(make-local-variable 'defun-prompt-regexp)
! (setq defun-prompt-regexp "^[ \t]*sub[ \t]+\\([^ \t\n{(;]+\\)\\([
\t]*([^()]*)[ \t]*\\)?[ \t]*")
(make-local-variable 'comment-indent-function)
(setq comment-indent-function 'cperl-comment-indent)
(make-local-variable 'parse-sexp-ignore-comments)
***************
*** 1692,1698 ****
(save-excursion
(up-list (- (prefix-numeric-value arg)))
;;(cperl-after-block-p (point-min))
! (cperl-after-expr-p nil "{;)"))
(error nil))))
;; Just insert the guy
(self-insert-command (prefix-numeric-value arg))
--- 1700,1708 ----
(save-excursion
(up-list (- (prefix-numeric-value arg)))
;;(cperl-after-block-p (point-min))
! (or (cperl-after-expr-p nil "{;)")
! ;; after sub, else, continue
! (cperl-after-block-p nil 'pre)))
(error nil))))
;; Just insert the guy
(self-insert-command (prefix-numeric-value arg))
***************
*** 1772,1778 ****
(goto-char pos)))))
(defun cperl-electric-paren (arg)
! "Insert a matching pair of parentheses."
(interactive "P")
(let ((beg (save-excursion (beginning-of-line) (point)))
(other-end (if (and cperl-electric-parens-mark
--- 1782,1789 ----
(goto-char pos)))))
(defun cperl-electric-paren (arg)
! "Insert an opening parenthesis or a matching pair of parentheses.
! See `cperl-electric-parens'."
(interactive "P")
(let ((beg (save-excursion (beginning-of-line) (point)))
(other-end (if (and cperl-electric-parens-mark
***************
*** 1807,1813 ****
(defun cperl-electric-rparen (arg)
"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
--- 1818,1825 ----
(defun cperl-electric-rparen (arg)
"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.
! Affected by `cperl-electric-parens'."
(interactive "P")
(let ((beg (save-excursion (beginning-of-line) (point)))
(other-end (if (and cperl-electric-parens-mark
***************
*** 1867,1872 ****
--- 1879,1886 ----
(not (eq (get-text-property (point)
'syntax-type)
'pod))))))
+ (save-excursion (forward-sexp -1)
+ (not (memq (following-char) (append "address@hidden&*"
nil))))
(progn
(and (eq (preceding-char) ?y)
(progn ; "foreachmy"
***************
*** 1896,1902 ****
(if my
(forward-char 1)
(delete-char 1)))
! (search-backward ")"))
(if delete
(cperl-putback-char cperl-del-back-ch))
(if cperl-message-electric-keyword
--- 1910,1920 ----
(if my
(forward-char 1)
(delete-char 1)))
! (search-backward ")")
! (if (eq last-command-char ?\()
! (progn ; Avoid "if (())"
! (delete-backward-char 1)
! (delete-backward-char -1))))
(if delete
(cperl-putback-char cperl-del-back-ch))
(if cperl-message-electric-keyword
***************
*** 2185,2192 ****
(self-insert-command (prefix-numeric-value arg)))))
(defun cperl-electric-backspace (arg)
! "Backspace-untabify, or remove the whitespace around the point inserted
! by an electric key."
(interactive "p")
(if (and cperl-auto-newline
(memq last-command '(cperl-electric-semi
--- 2203,2210 ----
(self-insert-command (prefix-numeric-value arg)))))
(defun cperl-electric-backspace (arg)
! "Backspace, or remove the whitespace around the point inserted by an
electric
! key. Will untabify if `cperl-electric-backspace-untabify' is non-nil."
(interactive "p")
(if (and cperl-auto-newline
(memq last-command '(cperl-electric-semi
***************
*** 2210,2216 ****
(setq p (point))
(skip-chars-backward " \t\n")
(delete-region (point) p))
! (backward-delete-char-untabify arg))))
(defun cperl-inside-parens-p ()
(condition-case ()
--- 2228,2236 ----
(setq p (point))
(skip-chars-backward " \t\n")
(delete-region (point) p))
! (if cperl-electric-backspace-untabify
! (backward-delete-char-untabify arg)
! (delete-backward-char arg)))))
(defun cperl-inside-parens-p ()
(condition-case ()
***************
*** 2370,2375 ****
--- 2390,2396 ----
Will not correct the indentation for labels, but will correct it for braces
and closing parentheses and brackets."
+ (cperl-update-syntaxification (point) (point))
(save-excursion
(if (or
(and (memq (get-text-property (point) 'syntax-type)
***************
*** 2467,2473 ****
(progn
(forward-sexp -1)
(skip-chars-backward " \t")
! (looking-at "[ \t]*[a-zA-Z_][a-zA-Z_0-9]*[
\t]*:"))))
(progn
(if (and parse-data
(not (eq char-after ?\C-j)))
--- 2488,2495 ----
(progn
(forward-sexp -1)
(skip-chars-backward " \t")
! (looking-at "[ \t]*[a-zA-Z_][a-zA-Z_0-9]*[
\t]*:")))
! (get-text-property (point) 'first-format-line))
(progn
(if (and parse-data
(not (eq char-after ?\C-j)))
***************
*** 2545,2551 ****
(append (if is-block " ;{" " ,;{") '(nil)))
(and (eq (preceding-char) ?\})
(cperl-after-block-and-statement-beg
! containing-sexp))))
;; This line is continuation of preceding line's statement;
;; indent `cperl-continued-statement-offset' more than
the
;; previous line of the statement.
--- 2567,2574 ----
(append (if is-block " ;{" " ,;{") '(nil)))
(and (eq (preceding-char) ?\})
(cperl-after-block-and-statement-beg
! containing-sexp))
! (get-text-property (point) 'first-format-line)))
;; This line is continuation of preceding line's statement;
;; indent `cperl-continued-statement-offset' more than
the
;; previous line of the statement.
***************
*** 2586,2596 ****
(forward-char 1)
(setq old-indent (current-indentation))
(let ((colon-line-end 0))
! (while (progn (skip-chars-forward " \t\n")
! (looking-at "#\\|[a-zA-Z0-9_$]*:[^:]"))
;; Skip over comments and labels following openbrace.
(cond ((= (following-char) ?\#)
(forward-line 1))
;; label:
(t
(save-excursion (end-of-line)
--- 2609,2624 ----
(forward-char 1)
(setq old-indent (current-indentation))
(let ((colon-line-end 0))
! (while
! (progn (skip-chars-forward " \t\n")
! (looking-at
"#\\|[a-zA-Z0-9_$]*:[^:]\\|=[a-zA-Z]"))
;; Skip over comments and labels following openbrace.
(cond ((= (following-char) ?\#)
(forward-line 1))
+ ((= (following-char) ?\=)
+ (goto-char
+ (or (next-single-property-change (point)
'in-pod)
+ (point-max)))) ; do not loop if no
syntaxification
;; label:
(t
(save-excursion (end-of-line)
***************
*** 3050,3056 ****
;; The body is marked `syntax-type' ==> `here-doc'
;; The delimiter is marked `syntax-type' ==> `here-doc-delim'
;; c) FORMATs:
! ;; After-initial-line--to-end is marked `syntax-type' ==> `format'
;; d) 'Q'uoted string:
;; part between markers inclusive is marked `syntax-type' ==>
`string'
;; part between `q' and the first marker is marked `syntax-type'
==> `prestring'
--- 3078,3085 ----
;; The body is marked `syntax-type' ==> `here-doc'
;; The delimiter is marked `syntax-type' ==> `here-doc-delim'
;; c) FORMATs:
! ;; First line (to =) marked `first-format-line' ==> t
! ;; After-this--to-end is marked `syntax-type' ==> `format'
;; d) 'Q'uoted string:
;; part between markers inclusive is marked `syntax-type' ==>
`string'
;; part between `q' and the first marker is marked `syntax-type'
==> `prestring'
***************
*** 3147,3153 ****
"\\([^\"'`\n]*\\)" ; 3 + 1
"\\3"
"\\|"
! ;; Second variant: Identifier or \ID or empty
"\\\\?\\(\\([a-zA-Z_][a-zA-Z_0-9]*\\)?\\)" ; 4 + 1, 5 + 1
;; Do not have <<= or << 30 or <<30 or << $blah.
;; "\\([^= address@hidden&]\\|[ \t]+[^ address@hidden&]\\)" ; 6 + 1
--- 3176,3182 ----
"\\([^\"'`\n]*\\)" ; 3 + 1
"\\3"
"\\|"
! ;; Second variant: Identifier or \ID (same as 'ID') or empty
"\\\\?\\(\\([a-zA-Z_][a-zA-Z_0-9]*\\)?\\)" ; 4 + 1, 5 + 1
;; Do not have <<= or << 30 or <<30 or << $blah.
;; "\\([^= address@hidden&]\\|[ \t]+[^ address@hidden&]\\)" ; 6 + 1
***************
*** 3178,3184 ****
"__\\(END\\|DATA\\)__"
;; 1+6+2+1+1+2+1+1+1=16 extra () before this:
"\\|"
! "\\\\\\(['`\"]\\)")
""))))
(unwind-protect
(progn
--- 3207,3213 ----
"__\\(END\\|DATA\\)__"
;; 1+6+2+1+1+2+1+1+1=16 extra () before this:
"\\|"
! "\\\\\\(['`\"($]\\)")
""))))
(unwind-protect
(progn
***************
*** 3195,3200 ****
--- 3224,3231 ----
cperl-postpone t
syntax-subtype t
rear-nonsticky t
+ here-doc-group t
+ first-format-line t
indentable t))
;; Need to remove face as well...
(goto-char min)
***************
*** 3239,3245 ****
--- 3270,3278 ----
max e '(syntax-type t in-pod t syntax-table t
cperl-postpone t
syntax-subtype t
+ here-doc-group t
rear-nonsticky t
+ first-format-line t
indentable t))
(setq tmpend tb)))
(put-text-property b e 'in-pod t)
***************
*** 3287,3292 ****
--- 3320,3326 ----
;;"<<"
;; "\\(" ; 1 + 1
;; ;; First variant "BLAH" or just ``.
+ ;; "[ \t]*" ; Yes, whitespace is allowed!
;; "\\([\"'`]\\)" ; 2 + 1
;; "\\([^\"'`\n]*\\)" ; 3 + 1
;; "\\3"
***************
*** 3328,3357 ****
(setq b (point))
;; We do not search to max, since we may be called from
;; some hook of fontification, and max is random
! (cond ((re-search-forward (concat "^" qtag "$")
! stop-point 'toend)
! (if cperl-pod-here-fontify
! (progn
! ;; Highlight the ending delimiter
! (cperl-postpone-fontification (match-beginning
0) (match-end 0)
! 'face
font-lock-constant-face)
! (cperl-put-do-not-fontify b (match-end 0) t)
! ;; Highlight the HERE-DOC
! (cperl-postpone-fontification b (match-beginning
0)
! 'face here-face)))
! (setq e1 (cperl-1+ (match-end 0)))
! (put-text-property b (match-beginning 0)
! 'syntax-type 'here-doc)
! (put-text-property (match-beginning 0) e1
! 'syntax-type 'here-doc-delim)
! (put-text-property b e1
! 'here-doc-group t)
! (cperl-commentify b e1 nil)
! (cperl-put-do-not-fontify b (match-end 0) t)
! (if (> e1 max)
! (setq tmpend tb)))
! (t (message "End of here-document `%s' not found." tag)
! (or (car err-l) (setcar err-l b))))))
;; format
((match-beginning 8)
;; 1+6=7 extra () before this:
--- 3362,3395 ----
(setq b (point))
;; We do not search to max, since we may be called from
;; some hook of fontification, and max is random
! (or (and (re-search-forward (concat "^" qtag "$")
! stop-point 'toend)
! (eq (following-char) ?\n))
! (progn ; Pretend we matched at the end
! (goto-char (point-max))
! (re-search-forward "\\'")
! (message "End of here-document `%s' not found." tag)
! (or (car err-l) (setcar err-l b))))
! (if cperl-pod-here-fontify
! (progn
! ;; Highlight the ending delimiter
! (cperl-postpone-fontification (match-beginning 0)
(match-end 0)
! 'face
font-lock-constant-face)
! (cperl-put-do-not-fontify b (match-end 0) t)
! ;; Highlight the HERE-DOC
! (cperl-postpone-fontification b (match-beginning 0)
! 'face here-face)))
! (setq e1 (cperl-1+ (match-end 0)))
! (put-text-property b (match-beginning 0)
! 'syntax-type 'here-doc)
! (put-text-property (match-beginning 0) e1
! 'syntax-type 'here-doc-delim)
! (put-text-property b e1
! 'here-doc-group t)
! (cperl-commentify b e1 nil)
! (cperl-put-do-not-fontify b (match-end 0) t)
! (if (> e1 max)
! (setq tmpend tb))))
;; format
((match-beginning 8)
;; 1+6=7 extra () before this:
***************
*** 3363,3368 ****
--- 3401,3410 ----
"")
tb (match-beginning 0))
(setq argument nil)
+ (put-text-property (save-excursion
+ (beginning-of-line)
+ (point))
+ b 'first-format-line 't)
(if cperl-pod-here-fontify
(while (and (eq (forward-line) 0)
(not (looking-at "^[.;]$")))
***************
*** 3415,3427 ****
bb (char-after (1- (match-beginning b1))) ; tmp holder
;; bb == "Not a stringy"
bb (if (eq b1 10) ; user variables/whatever
! (or
! (memq bb '(?\$ ?\@ ?\% ?\* ?\#)) ; $#y
! (and (eq bb ?-) (eq c ?s)) ; -s file test
! (and (eq bb ?\&)
! (not (eq (char-after ; &&m/blah/
! (- (match-beginning b1) 2))
! ?\&))))
;; <file> or <$file>
(and (eq c ?\<)
;; Do not stringify <FH>, <$fh> :
--- 3457,3477 ----
bb (char-after (1- (match-beginning b1))) ; tmp holder
;; bb == "Not a stringy"
bb (if (eq b1 10) ; user variables/whatever
! (and (memq bb (append "address@hidden:-&>" nil)) ;
$#y)
! (cond ((eq bb ?-) (eq c ?s)) ; -s file test
! ((eq bb ?\:) ; $opt::s
! (eq (char-after
! (- (match-beginning b1) 2))
! ?\:))
! ((eq bb ?\>) ; $foo->s
! (eq (char-after
! (- (match-beginning b1) 2))
! ?\-))
! ((eq bb ?\&)
! (not (eq (char-after ; &&m/blah/
! (- (match-beginning b1) 2))
! ?\&)))
! (t t)))
;; <file> or <$file>
(and (eq c ?\<)
;; Do not stringify <FH>, <$fh> :
***************
*** 3434,3439 ****
--- 3484,3490 ----
(or bb
(if (eq b1 11) ; bare /blah/ or ?blah? or <foo>
(setq argument ""
+ b1 nil
bb ; Not a regexp?
(progn
(not
***************
*** 3472,3487 ****
(looking-at "\\s|")))))))
b (1- b))
;; s y tr m
! ;; Check for $a->y
! (if (and (eq (preceding-char) ?>)
! (eq (char-after (- (point) 2)) ?-))
;; Not a regexp
(setq bb t))))
(or bb (setq state (parse-partial-sexp
state-point b nil nil state)
state-point b))
(goto-char b)
! (if (or bb (nth 3 state) (nth 4 state))
(goto-char i)
;; Skip whitespace and comments...
(if (looking-at "[ \t\n\f]+\\(#[^\n]*\n[ \t\n\f]*\\)+")
--- 3523,3580 ----
(looking-at "\\s|")))))))
b (1- b))
;; s y tr m
! ;; Check for $a -> y
! (setq b1 (preceding-char)
! go (point))
! (if (and (eq b1 ?>)
! (eq (char-after (- go 2)) ?-))
;; Not a regexp
(setq bb t))))
(or bb (setq state (parse-partial-sexp
state-point b nil nil state)
state-point b))
+ (setq bb (or bb (nth 3 state) (nth 4 state)))
(goto-char b)
! (or bb
! (progn
! (if (looking-at "[ \t\n\f]+\\(#[^\n]*\n[ \t\n\f]*\\)+")
! (goto-char (match-end 0))
! (skip-chars-forward " \t\n\f"))
! (cond ((and (eq (following-char) ?\})
! (eq b1 ?\{))
! ;; Check for $a[23]->{ s }, @{s} and *{s::foo}
! (goto-char (1- go))
! (skip-chars-backward " \t\n\f")
! (if (memq (preceding-char) (append
"address@hidden&*" nil))
! (setq bb t) ; @{y}
! (condition-case nil
! (forward-sexp -1)
! (error nil)))
! (if (or bb
! (looking-at ; $foo -> {s}
!
"address@hidden([a-zA-Z0-9_:]+\\|[^{]\\)\\([ \t\n]*->\\)?[ \t\n]*{")
! (and ; $foo[12] -> {s}
! (memq (following-char) '(?\{ ?\[))
! (progn
! (forward-sexp 1)
! (looking-at "\\([ \t\n]*->\\)?[
\t\n]*{"))))
! (setq bb t)
! (goto-char b)))
! ((and (eq (following-char) ?=)
! (eq (char-after (1+ (point))) ?\>))
! ;; Check for { foo => 1, s => 2 }
! ;; Apparently s=> is never a substitution...
! (setq bb t))
! ((and (eq (following-char) ?:)
! (eq b1 ?\{) ; Check for $ { s::bar }
! (looking-at "::[a-zA-Z0-9_:]*[ \t\n\f]*}")
! (progn
! (goto-char (1- go))
! (skip-chars-backward " \t\n\f")
! (memq (preceding-char)
! (append "address@hidden&*" nil))))
! (setq bb t)))))
! (if bb
(goto-char i)
;; Skip whitespace and comments...
(if (looking-at "[ \t\n\f]+\\(#[^\n]*\n[ \t\n\f]*\\)+")
***************
*** 3703,3709 ****
(cperl-commentify b bb nil)
(setq end t))
(goto-char bb))
! ((match-beginning 17) ; "\\\\\\(['`\"]\\)"
(setq bb (match-end 0)
b (match-beginning 0))
(goto-char b)
--- 3796,3803 ----
(cperl-commentify b bb nil)
(setq end t))
(goto-char bb))
! ((match-beginning 17) ; "\\\\\\(['`\"($]\\)"
! ;; Trailing backslash ==> non-quoting outside string/comment
(setq bb (match-end 0)
b (match-beginning 0))
(goto-char b)
***************
*** 3752,3770 ****
(if (< p (point)) (goto-char p))
(setq stop t)))))))
! (defun cperl-after-block-p (lim)
;; We suppose that the preceding char is }.
(save-excursion
(condition-case nil
(progn
! (forward-sexp -1)
(cperl-backward-to-noncomment lim)
(or (eq (point) lim)
(eq (preceding-char) ?\) ) ; if () {} sub f () {}
(if (eq (char-syntax (preceding-char)) ?w) ; else {}
(save-excursion
(forward-sexp -1)
! (or (looking-at
"\\(else\\|grep\\|map\\|BEGIN\\|END\\|CHECK\\|INIT\\)\\>")
;; sub f {}
(progn
(cperl-backward-to-noncomment lim)
--- 3846,3867 ----
(if (< p (point)) (goto-char p))
(setq stop t)))))))
! (defun cperl-after-block-p (lim &optional pre-block)
! "Return true if the preceeding } ends a block or a following { starts one.
! Would not look before LIM. If PRE-BLOCK is nil checks preceeding }.
! otherwise following {."
;; We suppose that the preceding char is }.
(save-excursion
(condition-case nil
(progn
! (or pre-block (forward-sexp -1))
(cperl-backward-to-noncomment lim)
(or (eq (point) lim)
(eq (preceding-char) ?\) ) ; if () {} sub f () {}
(if (eq (char-syntax (preceding-char)) ?w) ; else {}
(save-excursion
(forward-sexp -1)
! (or (looking-at
"\\(else\\|continue\\|grep\\|map\\|BEGIN\\|END\\|CHECK\\|INIT\\)\\>")
;; sub f {}
(progn
(cperl-backward-to-noncomment lim)
***************
*** 3781,3795 ****
CHARS is a string that contains good characters to have before us (however,
`}' is treated \"smartly\" if it is not in the list)."
(let ((lim (or lim (point-min)))
! stop p)
(save-excursion
(while (and (not stop) (> (point) lim))
(skip-chars-backward " \t\n\f" lim)
(setq p (point))
(beginning-of-line)
(if (looking-at "^[ \t]*\\(#\\|$\\)") nil ; Only comment, skip
;; Else: last iteration, or a label
! (cperl-to-comment-or-eol)
(skip-chars-backward " \t")
(if (< p (point)) (goto-char p))
(setq p (point))
--- 3878,3905 ----
CHARS is a string that contains good characters to have before us (however,
`}' is treated \"smartly\" if it is not in the list)."
(let ((lim (or lim (point-min)))
! stop p pr)
! (cperl-update-syntaxification (point) (point))
(save-excursion
(while (and (not stop) (> (point) lim))
(skip-chars-backward " \t\n\f" lim)
(setq p (point))
(beginning-of-line)
+ ;;(memq (setq pr (get-text-property (point) 'syntax-type))
+ ;; '(pod here-doc here-doc-delim))
+ (if (get-text-property (point) 'here-doc-group)
+ (progn
+ (goto-char
+ (previous-single-property-change (point) 'here-doc-group))
+ (beginning-of-line 0)))
+ (if (get-text-property (point) 'in-pod)
+ (progn
+ (goto-char
+ (previous-single-property-change (point) 'in-pod))
+ (beginning-of-line 0)))
(if (looking-at "^[ \t]*\\(#\\|$\\)") nil ; Only comment, skip
;; Else: last iteration, or a label
! (cperl-to-comment-or-eol) ; Will not move past "." after a format
(skip-chars-backward " \t")
(if (< p (point)) (goto-char p))
(setq p (point))
***************
*** 3808,3814 ****
(if test (eval test)
(or (memq (preceding-char) (append (or chars "{;") nil))
(and (eq (preceding-char) ?\})
! (cperl-after-block-p lim)))))))))
(defun cperl-backward-to-start-of-continued-exp (lim)
(if (memq (preceding-char) (append ")]}\"'`" nil))
--- 3918,3927 ----
(if test (eval test)
(or (memq (preceding-char) (append (or chars "{;") nil))
(and (eq (preceding-char) ?\})
! (cperl-after-block-p lim))
! (and (eq (following-char) ?.) ; in format: see comment above
! (eq (get-text-property (point) 'syntax-type)
! 'format)))))))))
(defun cperl-backward-to-start-of-continued-exp (lim)
(if (memq (preceding-char) (append ")]}\"'`" nil))
***************
*** 3931,3937 ****
(if (looking-at
"[ \t]*\\<for\\(each\\)?[ \t]+\\(my\\|local\\|our\\)[
\t]*\\$[_a-zA-Z0-9]+\\(\t*\\|[ \t][ \t]+\\)[^ \t\n#]")
(progn
! (forward-word 3)
(delete-horizontal-space)
(insert
(make-string cperl-indent-region-fix-constructs ?\ ))
--- 4044,4050 ----
(if (looking-at
"[ \t]*\\<for\\(each\\)?[ \t]+\\(my\\|local\\|our\\)[
\t]*\\$[_a-zA-Z0-9]+\\(\t*\\|[ \t][ \t]+\\)[^ \t\n#]")
(progn
! (forward-sexp 3)
(delete-horizontal-space)
(insert
(make-string cperl-indent-region-fix-constructs ?\ ))
***************
*** 5394,5406 ****
(if (cperl-val 'cperl-electric-parens) "" "not ")))
(defun cperl-toggle-autohelp ()
! "Toggle the state of automatic help message in CPerl mode.
! See `cperl-lazy-help-time' too."
(interactive)
(if (fboundp 'run-with-idle-timer)
(progn
(if cperl-lazy-installed
! (eval '(cperl-lazy-unstall))
(cperl-lazy-install))
(message "Perl help messages will %sbe automatically shown now."
(if cperl-lazy-installed "" "not ")))
--- 5507,5519 ----
(if (cperl-val 'cperl-electric-parens) "" "not ")))
(defun cperl-toggle-autohelp ()
! "Toggle the state of Auto-Help on Perl constructs (put in the message area).
! Delay of auto-help controlled by `cperl-lazy-help-time'."
(interactive)
(if (fboundp 'run-with-idle-timer)
(progn
(if cperl-lazy-installed
! (cperl-lazy-unstall)
(cperl-lazy-install))
(message "Perl help messages will %sbe automatically shown now."
(if cperl-lazy-installed "" "not ")))
***************
*** 6131,6142 ****
(defvar cperl-short-docs 'please-ignore-this-line
;; Perl4 version was written by Johan Vromans (address@hidden)
"# based on '@(#)@ perl-descr.el 1.9 - describe-perl-symbol' [Perl 5]
! ... 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 %.15g or close.
$$ Process number of this script. Changes in the fork()ed child process.
$% The current page number of the currently selected output channel.
--- 6244,6256 ----
(defvar cperl-short-docs 'please-ignore-this-line
;; Perl4 version was written by Johan Vromans (address@hidden)
"# based on '@(#)@ perl-descr.el 1.9 - describe-perl-symbol' [Perl 5]
+ ... Range (list context); flip/flop [no flop when flip] (scalar context).
! ... 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. Default is %.15g or close.
$$ Process number of this script. Changes in the fork()ed child process.
$% The current page number of the currently selected output channel.
***************
*** 6163,6169 ****
$- 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\".
$< The real uid of this process.
--- 6277,6283 ----
$- 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 current perl script (read/write).
$: String may be broken after these characters to fill ^-lines in a
format.
$; Subscript separator for multi-dim array emulation. Default \"\\034\".
$< The real uid of this process.
***************
*** 6240,6251 ****
-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 assignment.
/PATTERN/ioxsmg Pattern match.
! ... < ... Numeric less than. <pattern> Glob. See <NAME>, <>
as well.
<NAME> Reads line from filehandle NAME (a bareword or dollar-bareword).
<pattern> Glob (Unless pattern is bareword/dollar-bareword - see <NAME>).
<> Reads line from union of files in @ARGV (= command line) and STDIN.
--- 6354,6365 ----
-x File is executable by effective uid.
-z File has zero size.
. Concatenate strings.
! .. Range (list context); flip/flop (scalar context) operator.
.= Concatenate assignment strings
... / ... Division. /PATTERN/ioxsmg Pattern match
... /= ... Division assignment.
/PATTERN/ioxsmg Pattern match.
! ... < ... Numeric less than. <pattern> Glob. See <NAME>, <>
as well.
<NAME> Reads line from filehandle NAME (a bareword or dollar-bareword).
<pattern> Glob (Unless pattern is bareword/dollar-bareword - see <NAME>).
<> Reads line from union of files in @ARGV (= command line) and STDIN.
***************
*** 6263,6269 ****
?PATTERN? One-time 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 reference to what follows, like \$var, or quotes non-\w in
strings.
\\0 Octal char, e.g. \\033.
\\E Case modification terminator. See \\Q, \\L, and \\U.
--- 6377,6383 ----
?PATTERN? One-time 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; result of split() unless in list
context.
\\ Creates reference to what follows, like \$var, or quotes non-\w in
strings.
\\0 Octal char, e.g. \\033.
\\E Case modification terminator. See \\Q, \\L, and \\U.
***************
*** 6969,6982 ****
default-entry)
input))))
(require 'man)
! (let* ((is-func (and
(string-match "^[a-z]+$" word)
(string-match (concat "^" word "\\>")
(documentation-property
'cperl-short-docs
'variable-documentation))))
(manual-program (if is-func "perldoc -f" "perldoc")))
! (Man-getpage-in-background word)))
(defun cperl-perldoc-at-point ()
"Run a `perldoc' on the word around point."
--- 7083,7103 ----
default-entry)
input))))
(require 'man)
! (let* ((case-fold-search nil)
! (is-func (and
(string-match "^[a-z]+$" word)
(string-match (concat "^" word "\\>")
(documentation-property
'cperl-short-docs
'variable-documentation))))
(manual-program (if is-func "perldoc -f" "perldoc")))
! (cond
! (cperl-xemacs-p
! (let ((Manual-program "perldoc")
! (Manual-switches (if is-func (list "-f"))))
! (manual-entry word)))
! (t
! (Man-getpage-in-background word)))))
(defun cperl-perldoc-at-point ()
"Run a `perldoc' on the word around point."
***************
*** 7006,7011 ****
--- 7127,7145 ----
(format (cperl-pod2man-build-command) pod2man-args))
'Man-bgproc-sentinel)))))
+ ;;; Updated version by him too
+ (defun cperl-build-manpage ()
+ "Create a virtual manpage in Emacs from the POD in the file."
+ (interactive)
+ (require 'man)
+ (cond
+ (cperl-xemacs-p
+ (let ((Manual-program "perldoc"))
+ (manual-entry buffer-file-name)))
+ (t
+ (let* ((manual-program "perldoc"))
+ (Man-getpage-in-background buffer-file-name)))))
+
(defun cperl-pod2man-build-command ()
"Builds the entire background manpage and cleaning command."
(let ((command (concat pod2man-program " %s 2>/dev/null"))
***************
*** 7024,7029 ****
--- 7158,7164 ----
command))
(defun cperl-lazy-install ()) ; Avoid a warning
+ (defun cperl-lazy-unstall ()) ; Avoid a warning
(if (fboundp 'run-with-idle-timer)
(progn
***************
*** 7034,7039 ****
--- 7169,7176 ----
"Non-nil means that the lazy-help handlers are installed now.")
(defun cperl-lazy-install ()
+ "Switches on Auto-Help on Perl constructs (put in the message area).
+ Delay of auto-help controlled by `cperl-lazy-help-time'."
(interactive)
(make-variable-buffer-local 'cperl-help-shown)
(if (and (cperl-val 'cperl-lazy-help-time)
***************
*** 7047,7052 ****
--- 7184,7191 ----
(setq cperl-lazy-installed t))))
(defun cperl-lazy-unstall ()
+ "Switches off Auto-Help on Perl constructs (put in the message area).
+ Delay of auto-help controlled by `cperl-lazy-help-time'."
(interactive)
(remove-hook 'post-command-hook 'cperl-lazy-hook)
(cancel-function-timers 'cperl-get-help-defer)
***************
*** 7123,7129 ****
(cperl-fontify-syntaxically to)))))
(defvar cperl-version
! (let ((v "Revision: 4.35"))
(string-match ":\\s *\\([0-9.]+\\)" v)
(substring v (match-beginning 1) (match-end 1)))
"Version of IZ-supported CPerl package this file is based on.")
--- 7262,7268 ----
(cperl-fontify-syntaxically to)))))
(defvar cperl-version
! (let ((v "Revision: 5.0"))
(string-match ":\\s *\\([0-9.]+\\)" v)
(substring v (match-beginning 1) (match-end 1)))
"Version of IZ-supported CPerl package this file is based on.")
- [Emacs-diffs] Changes to emacs/lisp/progmodes/cperl-mode.el, Juanma Barranquero, 2003/02/04
- [Emacs-diffs] Changes to emacs/lisp/progmodes/cperl-mode.el, Juanma Barranquero, 2003/02/14
- [Emacs-diffs] Changes to emacs/lisp/progmodes/cperl-mode.el, Juanma Barranquero, 2003/02/18
- [Emacs-diffs] Changes to emacs/lisp/progmodes/cperl-mode.el, Stefan Monnier, 2003/02/19
- [Emacs-diffs] Changes to emacs/lisp/progmodes/cperl-mode.el, Stefan Monnier, 2003/02/19
- [Emacs-diffs] Changes to emacs/lisp/progmodes/cperl-mode.el, Stefan Monnier, 2003/02/22
- [Emacs-diffs] Changes to emacs/lisp/progmodes/cperl-mode.el,
Stefan Monnier <=