;;; cperl-mode.el --- Perl code editing commands for Emacs
-;; Copyright (C) 1985,86,87,91,92,93,94,95,96,97,98,99,2000,03,2004,2005
+;; Copyright (C) 1985, 1986, 1987, 1991, 1992, 1993, 1994, 1995, 1996, 1997,
+;; 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005
;; Free Software Foundation, Inc.
;; Author: Ilya Zakharevich and Bob Olson
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Corrections made by Ilya Zakharevich cperl@ilyaz.org
;;; Code:
+(defvar vc-rcs-header)
+(defvar vc-sccs-header)
+
;; Some macros are needed for `defcustom'
(eval-when-compile
(condition-case nil
;; Probably will not work due to some save-excursion???
;; Or save-file-position?
;; (message "Did I get to line %s?" (elt (, elt) 1))
- `(goto-line (string-to-int (elt ,elt 1))))
+ `(goto-line (string-to-number (elt ,elt 1))))
;;)
(defmacro cperl-etags-goto-tag-location (elt)
`(etags-goto-tag-location ,elt))))
(defgroup cperl-faces nil
"Fontification colors."
+ :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces)
:prefix "cperl-"
:group 'cperl)
: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))
+(defvar cperl-vc-header-alist nil)
+(make-obsolete-variable
+ 'cperl-vc-header-alist
+ "use cperl-vc-rcs-header or cperl-vc-sccs-header instead.")
+
+(defcustom cperl-vc-sccs-header '("($sccs) = ('%W\%' =~ /(\\d+(\\.\\d+)+)/) ;")
+ "*Special version of `vc-sccs-header' that is used in CPerl mode buffers."
+ :type '(repeat string)
+ :group 'cperl)
+
+(defcustom cperl-vc-rcs-header '("($rcs) = (' $Id\$ ' =~ /(\\d+(\\.\\d+)+)/) ;")
+ "*Special version of `vc-rcs-header' that is used in CPerl mode buffers."
+ :type '(repeat string)
:group 'cperl)
(defcustom cperl-clobber-mode-lists
(defcustom cperl-info-on-command-no-prompt nil
"*Not-nil (and non-null) means not to prompt on C-h f.
-The opposite behaviour is always available if prefixed with C-c.
+The opposite behavior is always available if prefixed with C-c.
Can be overwritten by `cperl-hairy' if nil."
:type '(choice (const null) boolean)
:group 'cperl-affected-by-hairy)
(font-lock-variable-name-face nil nil bold)
(font-lock-function-name-face nil nil bold italic box)
(font-lock-constant-face nil "LightGray" bold)
- (cperl-array-face nil "LightGray" bold underline)
- (cperl-hash-face nil "LightGray" bold italic underline)
+ (cperl-array nil "LightGray" bold underline)
+ (cperl-hash nil "LightGray" bold italic underline)
(font-lock-comment-face nil "LightGray" italic)
(font-lock-string-face nil nil italic underline)
- (cperl-nonoverridable-face nil nil italic underline)
+ (cperl-nonoverridable nil nil italic underline)
(font-lock-type-face nil nil underline)
(underline nil "LightGray" strikeout))
"List given as an argument to `ps-extend-face-list' in `cperl-ps-print'."
(defvar cperl-dark-foreground
(cperl-choose-color "orchid1" "orange"))
-(defface cperl-nonoverridable-face
+(defface cperl-nonoverridable
`((((class grayscale) (background light))
(:background "Gray90" :slant italic :underline t))
(((class grayscale) (background dark))
(t (:weight bold :underline t)))
"Font Lock mode face used non-overridable keywords and modifiers of regexps."
:group 'cperl-faces)
+;; backward-compatibility alias
+(put 'cperl-nonoverridable-face 'face-alias 'cperl-nonoverridable)
-(defface cperl-array-face
+(defface cperl-array
`((((class grayscale) (background light))
(:background "Gray90" :weight bold))
(((class grayscale) (background dark))
(t (:weight bold)))
"Font Lock mode face used to highlight array names."
:group 'cperl-faces)
+;; backward-compatibility alias
+(put 'cperl-array-face 'face-alias 'cperl-array)
-(defface cperl-hash-face
+(defface cperl-hash
`((((class grayscale) (background light))
(:background "Gray90" :weight bold :slant italic))
(((class grayscale) (background dark))
(t (:weight bold :slant italic)))
"Font Lock mode face used to highlight hash names."
:group 'cperl-faces)
+;; backward-compatibility alias
+(put 'cperl-hash-face 'face-alias 'cperl-hash)
\f
(defvar cperl-tips-faces 'please-ignore-this-line
"CPerl mode uses following faces for highlighting:
- `cperl-array-face' Array names
- `cperl-hash-face' Hash names
+ `cperl-array' Array names
+ `cperl-hash' Hash names
`font-lock-comment-face' Comments, PODs and whatever is considered
syntaxically to be not code
`font-lock-constant-face' HERE-doc delimiters, labels, delimiters of
(except those conflicting with Perl operators),
package names (when recognized), format names
`font-lock-keyword-face' Control flow switch constructs, declarators
- `cperl-nonoverridable-face' Non-overridable keywords, modifiers of RExen
+ `cperl-nonoverridable' Non-overridable keywords, modifiers of RExen
`font-lock-string-face' Strings, qw() constructs, RExen, POD sections,
literal parts and the terminator of formats
and whatever is syntaxically considered
`font-lock-type-face' Overridable keywords
`font-lock-variable-name-face' Variable declarations, indirect array and
hash names, POD headers/item names
- `cperl-invalid-face' Trailing whitespace
+ `cperl-invalid' Trailing whitespace
Note that in several situations the highlighting tries to inform about
possible confusion, such as different colors for function names in
and you are on a boundary of a statement inside braces, it will
transform the construct into a multiline and will place you into an
appropriately indented blank line. If you need a usual
-`newline-and-indent' behaviour, it is on \\[newline-and-indent],
+`newline-and-indent' behavior, it is on \\[newline-and-indent],
see documentation on `cperl-electric-linefeed'.
Use \\[cperl-invert-if-unless] to change a construction of the form
(make-local-variable 'comment-start-skip)
(setq comment-start-skip "#+ *")
(make-local-variable 'defun-prompt-regexp)
- (setq defun-prompt-regexp "^[ \t]*sub[ \t\n]+\\([^ \t\n{(;]+\\)\\([ \t\n]*([^()]*)[ \t\n]*\\)?[ \t\n]*)")
+ (setq defun-prompt-regexp "^[ \t]*sub[ \t\n]+\\([^ \t\n{(;]+\\)\\([ \t\n]*([^()]*)[ \t\n]*\\)?[ \t\n]*")
(make-local-variable 'comment-indent-function)
(setq comment-indent-function 'cperl-comment-indent)
(make-local-variable 'parse-sexp-ignore-comments)
(function cperl-imenu--create-perl-index))
(make-local-variable 'imenu-sort-function)
(setq imenu-sort-function nil)
- (make-local-variable 'vc-header-alist)
- (set 'vc-header-alist cperl-vc-header-alist) ; Avoid warning
+ (make-local-variable 'vc-rcs-header)
+ (set 'vc-rcs-header cperl-vc-rcs-header)
+ (make-local-variable 'vc-sccs-header)
+ (set 'vc-sccs-header cperl-vc-sccs-header)
(make-local-variable 'font-lock-defaults)
(setq font-lock-defaults
(cond
(t
'((cperl-load-font-lock-keywords
cperl-load-font-lock-keywords-1
- cperl-load-font-lock-keywords-2)))))
+ cperl-load-font-lock-keywords-2)
+ nil nil ((?_ . "w"))))))
(make-local-variable 'cperl-syntax-state)
(if cperl-use-syntax-table-text-property
(progn
(save-excursion
(skip-chars-backward "$")
(looking-at "\\(\\$\\$\\)*\\$\\([^\\$]\\|$\\)"))
- (insert ?\ ))
+ (insert ?\s))
;; Check whether we are in comment
(if (and
(save-excursion
(let ((beg (save-excursion (beginning-of-line) (point)))
(dollar (and (eq last-command-char ?$)
(eq this-command 'self-insert-command)))
- (delete (and (memq last-command-char '(?\ ?\n ?\t ?\f))
+ (delete (and (memq last-command-char '(?\s ?\n ?\t ?\f))
(memq this-command '(self-insert-command newline))))
my do)
(and (save-excursion
(defun cperl-electric-pod ()
"Insert a POD chunk appropriate after a =POD directive."
- (let ((delete (and (memq last-command-char '(?\ ?\n ?\t ?\f))
+ (let ((delete (and (memq last-command-char '(?\s ?\n ?\t ?\f))
(memq this-command '(self-insert-command newline))))
head1 notlast name p really-delete over)
(and (save-excursion
(memq last-command '(cperl-electric-semi
cperl-electric-terminator
cperl-electric-lbrace))
- (memq (preceding-char) '(?\ ?\t ?\n)))
+ (memq (preceding-char) '(?\s ?\t ?\n)))
(let (p)
(if (eq last-command 'cperl-electric-lbrace)
(skip-chars-forward " \t\n"))
(setq this-command 'cperl-electric-else-really))
(if (and cperl-auto-newline
(eq last-command 'cperl-electric-else-really)
- (memq (preceding-char) '(?\ ?\t ?\n)))
+ (memq (preceding-char) '(?\s ?\t ?\n)))
(let (p)
(skip-chars-forward " \t\n")
(setq p (point))
(progn
(setq i (point) i2 i)
(if ender
- (if (memq (following-char) '(?\ ?\t ?\n ?\f))
+ (if (memq (following-char) '(?\s ?\t ?\n ?\f))
(progn
(if (looking-at "[ \t\n\f]+\\(#[^\n]*\n[ \t\n\f]*\\)+")
(goto-char (match-end 0))
(cperl-nonoverridable-face
(if (boundp 'cperl-nonoverridable-face)
cperl-nonoverridable-face
- 'cperl-nonoverridable-face))
+ 'cperl-nonoverridable))
(stop-point (if ignore-max
(point-max)
max))
(forward-word 1) ; skip modifiers s///s
(if tail (cperl-commentify tail (point) t))
(cperl-postpone-fontification
- e1 (point) 'face 'cperl-nonoverridable-face)))
+ e1 (point) 'face 'cperl-nonoverridable)))
;; Check whether it is m// which means "previous match"
;; and highlight differently
(setq is-REx
(and (buffer-modified-p)
(not modified)
(set-buffer-modified-p nil))
- (set-syntax-table cperl-mode-syntax-table))
+ ;; I do not understand what this is doing here. It breaks font-locking
+ ;; because it resets the syntax-table from font-lock-syntax-table to
+ ;; cperl-mode-syntax-table.
+ ;; (set-syntax-table cperl-mode-syntax-table)
+ )
(car err-l)))
(defun cperl-backward-to-noncomment (lim)
(setq p (point))
(skip-chars-forward " \t\n")
(delete-region p (point))
- (insert (make-string cperl-indent-region-fix-constructs ?\ ))
+ (insert (make-string cperl-indent-region-fix-constructs ?\s))
(beginning-of-line)))
;; Looking at:
;; } else
(progn
(search-forward "}")
(delete-horizontal-space)
- (insert (make-string cperl-indent-region-fix-constructs ?\ ))
+ (insert (make-string cperl-indent-region-fix-constructs ?\s))
(beginning-of-line)))
;; Looking at:
;; else {
(progn
(forward-word 1)
(delete-horizontal-space)
- (insert (make-string cperl-indent-region-fix-constructs ?\ ))
+ (insert (make-string cperl-indent-region-fix-constructs ?\s))
(beginning-of-line)))
;; Looking at:
;; foreach my $var
(progn
(forward-word 2)
(delete-horizontal-space)
- (insert (make-string cperl-indent-region-fix-constructs ?\ ))
+ (insert (make-string cperl-indent-region-fix-constructs ?\s))
(beginning-of-line)))
;; Looking at:
;; foreach my $var (
(forward-sexp 3)
(delete-horizontal-space)
(insert
- (make-string cperl-indent-region-fix-constructs ?\ ))
+ (make-string cperl-indent-region-fix-constructs ?\s))
(beginning-of-line)))
;; Looking at:
;; } foreach my $var () {
(cperl-fix-line-spacing end parse-data)
(setq ret (point)))))
(insert
- (make-string cperl-indent-region-fix-constructs ?\ ))))
+ (make-string cperl-indent-region-fix-constructs ?\s))))
((and (looking-at "[ \t]*\n")
(not (if ml
cperl-extra-newline-before-brace-multiline
(skip-chars-forward " \t\n")
(delete-region pp (point))
(insert
- (make-string cperl-indent-region-fix-constructs ?\ ))))
+ (make-string cperl-indent-region-fix-constructs ?\s))))
;; Now we are before `{'
(if (looking-at "[ \t\n]*{[ \t]*[^ \t\n#]")
(progn
(looking-at "#+[ \t]*")
(setq start (point) c (current-column)
comment-fill-prefix
- (concat (make-string (current-column) ?\ )
+ (concat (make-string (current-column) ?\s)
(buffer-substring (match-beginning 0) (match-end 0)))
spaces (progn (skip-chars-backward " \t")
(buffer-substring (point) start))
fill-column)
(let ((c (save-excursion (beginning-of-line)
(cperl-to-comment-or-eol) (point)))
- (s (memq (following-char) '(?\ ?\t))) marker)
+ (s (memq (following-char) '(?\s ?\t))) marker)
(if (>= c (point))
;; Don't break line inside code: only inside comment.
nil
(if (bolp) (progn (re-search-forward "#+[ \t]*")
(goto-char (match-end 0))))
;; Following space could have gone:
- (if (or (not s) (memq (following-char) '(?\ ?\t))) nil
+ (if (or (not s) (memq (following-char) '(?\s ?\t))) nil
(insert " ")
(backward-char 1))
;; Previous space could have gone:
- (or (memq (preceding-char) '(?\ ?\t)) (insert " "))))))
+ (or (memq (preceding-char) '(?\s ?\t)) (insert " "))))))
(defun cperl-imenu-addback (lst &optional isback name)
;; We suppose that the lst is a DAG, unless the first element only
"u\\(se\\|n\\(shift\\|ti\\(l\\|e\\)\\|def\\|less\\)\\)\\|"
"while\\|y\\|__\\(END\\|DATA\\)__" ;__DATA__ added manually
"\\|[sm]" ; Added manually
- "\\)\\>") 2 'cperl-nonoverridable-face)
+ "\\)\\>") 2 'cperl-nonoverridable)
;; (mapconcat 'identity
;; '("#endif" "#else" "#ifdef" "#ifndef" "#if"
;; "#include" "#define" "#undef")
3 font-lock-variable-name-face)))
'("\\<for\\(each\\)?\\([ \t]+\\(my\\|local\\|our\\)\\)?[ \t]*\\(\\$[a-zA-Z_][a-zA-Z_0-9]*\\)[ \t]*("
4 font-lock-variable-name-face)
- ;; Avoid s!!, qq!! etc. when not fontifying syntaxically
- '("\\(?:^\\|[^smywqrx]\\)\\(!\\)" 1 font-lock-negation-char-face)
+ ;; Avoid $!, and s!!, qq!! etc. when not fontifying syntaxically
+ '("\\(?:^\\|[^smywqrx$]\\)\\(!\\)" 1 font-lock-negation-char-face)
'("\\[\\(\\^\\)" 1 font-lock-negation-char-face prepend)))
(setq
t-font-lock-keywords-1
'(
("\\(\\([@%]\\|\$#\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)" 1
(if (eq (char-after (match-beginning 2)) ?%)
- cperl-hash-face
- cperl-array-face)
+ 'cperl-hash
+ 'cperl-array)
t) ; arrays and hashes
("\\(\\([$@]+\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)[ \t]*\\([[{]\\)"
1
(if (= (- (match-end 2) (match-beginning 2)) 1)
(if (eq (char-after (match-beginning 3)) ?{)
- cperl-hash-face
- cperl-array-face) ; arrays and hashes
+ 'cperl-hash
+ 'cperl-array) ; arrays and hashes
font-lock-variable-name-face) ; Just to put something
t)
;;("\\([smy]\\|tr\\)\\([^a-z_A-Z0-9]\\)\\(\\([^\n\\]*||\\)\\)\\2")
[nil nil t t t]
nil
[nil nil t t t])
- (list 'cperl-nonoverridable-face
+ (list 'cperl-nonoverridable
["chartreuse3" ("orchid1" "orange")
nil "Gray80"]
[nil nil "gray90"]
[nil nil nil t t]
[nil nil t t]
[nil nil t t t])
- (list 'cperl-array-face
+ (list 'cperl-array
["blue" "yellow" nil "Gray80"]
["lightyellow2" ("navy" "os2blue" "darkgreen")
"gray90"]
t
nil
nil)
- (list 'cperl-hash-face
+ (list 'cperl-hash
["red" "red" nil "Gray80"]
["lightyellow2" ("navy" "os2blue" "darkgreen")
"gray90"]
"Face for variable names")
(cperl-force-face font-lock-type-face
"Face for data types")
- (cperl-force-face cperl-nonoverridable-face
+ (cperl-force-face cperl-nonoverridable
"Face for data types from another group")
(cperl-force-face font-lock-comment-face
"Face for comments")
(cperl-force-face font-lock-function-name-face
"Face for function names")
- (cperl-force-face cperl-hash-face
+ (cperl-force-face cperl-hash
"Face for hashes")
- (cperl-force-face cperl-array-face
+ (cperl-force-face cperl-array
"Face for arrays")
;;(defvar font-lock-constant-face 'font-lock-constant-face)
;;(defvar font-lock-variable-name-face 'font-lock-variable-name-face)
;; "Face to use for data types."))
;;(or (boundp 'cperl-nonoverridable-face)
;; (defconst cperl-nonoverridable-face
- ;; 'cperl-nonoverridable-face
+ ;; 'cperl-nonoverridable
;; "Face to use for data types from another group."))
;;(if (not cperl-xemacs-p) nil
;; (or (boundp 'font-lock-comment-face)
;; 'font-lock-function-name-face
;; "Face to use for function names.")))
(if (and
- (not (cperl-is-face 'cperl-array-face))
+ (not (cperl-is-face 'cperl-array))
(cperl-is-face 'font-lock-emphasized-face))
- (copy-face 'font-lock-emphasized-face 'cperl-array-face))
+ (copy-face 'font-lock-emphasized-face 'cperl-array))
(if (and
- (not (cperl-is-face 'cperl-hash-face))
+ (not (cperl-is-face 'cperl-hash))
(cperl-is-face 'font-lock-other-emphasized-face))
- (copy-face 'font-lock-other-emphasized-face
- 'cperl-hash-face))
+ (copy-face 'font-lock-other-emphasized-face 'cperl-hash))
(if (and
- (not (cperl-is-face 'cperl-nonoverridable-face))
+ (not (cperl-is-face 'cperl-nonoverridable))
(cperl-is-face 'font-lock-other-type-face))
- (copy-face 'font-lock-other-type-face
- 'cperl-nonoverridable-face))
+ (copy-face 'font-lock-other-type-face 'cperl-nonoverridable))
;;(or (boundp 'cperl-hash-face)
;; (defconst cperl-hash-face
- ;; 'cperl-hash-face
+ ;; 'cperl-hash
;; "Face to use for hashes."))
;;(or (boundp 'cperl-array-face)
;; (defconst cperl-array-face
- ;; 'cperl-array-face
+ ;; 'cperl-array
;; "Face to use for arrays."))
;; Here we try to guess background
(let ((background
"pink")))
(t
(set-face-background 'font-lock-type-face "gray90"))))
- (if (cperl-is-face 'cperl-nonoverridable-face)
+ (if (cperl-is-face 'cperl-nonoverridable)
nil
- (copy-face 'font-lock-type-face 'cperl-nonoverridable-face)
+ (copy-face 'font-lock-type-face 'cperl-nonoverridable)
(cond
((eq background 'light)
- (set-face-foreground 'cperl-nonoverridable-face
+ (set-face-foreground 'cperl-nonoverridable
(if (x-color-defined-p "chartreuse3")
"chartreuse3"
"chartreuse")))
((eq background 'dark)
- (set-face-foreground 'cperl-nonoverridable-face
+ (set-face-foreground 'cperl-nonoverridable
(if (x-color-defined-p "orchid1")
"orchid1"
"orange")))))
'(setq ps-bold-faces
;; font-lock-variable-name-face
;; font-lock-constant-face
- (append '(cperl-array-face
- cperl-hash-face)
+ (append '(cperl-array cperl-hash)
ps-bold-faces)
ps-italic-faces
;; font-lock-constant-face
- (append '(cperl-nonoverridable-face
- cperl-hash-face)
+ (append '(cperl-nonoverridable cperl-hash)
ps-italic-faces)
ps-underlined-faces
;; font-lock-type-face
- (append '(cperl-array-face
- cperl-hash-face
- underline
- cperl-nonoverridable-face)
+ (append '(cperl-array cperl-hash underline cperl-nonoverridable)
ps-underlined-faces))))
(defvar ps-print-face-extension-alist)
;;; (defvar ps-italic-faces nil)
;;; (setq ps-bold-faces
;;; (append '(font-lock-emphasized-face
-;;; cperl-array-face
+;;; cperl-array
;;; font-lock-keyword-face
;;; font-lock-variable-name-face
;;; font-lock-constant-face
;;; font-lock-reference-face
;;; font-lock-other-emphasized-face
-;;; cperl-hash-face)
+;;; cperl-hash)
;;; ps-bold-faces))
;;; (setq ps-italic-faces
-;;; (append '(cperl-nonoverridable-face
+;;; (append '(cperl-nonoverridable
;;; font-lock-constant-face
;;; font-lock-reference-face
;;; font-lock-other-emphasized-face
-;;; cperl-hash-face)
+;;; cperl-hash)
;;; ps-italic-faces))
;;; (setq ps-underlined-faces
;;; (append '(font-lock-emphasized-face
-;;; cperl-array-face
+;;; cperl-array
;;; font-lock-other-emphasized-face
-;;; cperl-hash-face
-;;; cperl-nonoverridable-face font-lock-type-face)
+;;; cperl-hash
+;;; cperl-nonoverridable font-lock-type-face)
;;; ps-underlined-faces))
;;; (cons 'font-lock-type-face ps-underlined-faces))
(set (car setting) (cdr setting)))))
(defun cperl-set-style-back ()
- "Restore a style memorised by `cperl-set-style'."
+ "Restore a style memorized by `cperl-set-style'."
(interactive)
(or cperl-old-style (error "The style was not changed"))
(let (setting)
(setq e (point))
(skip-chars-backward " \t")
(delete-region (point) e)
- (indent-to-column col) ;(make-string (- col (current-column)) ?\ ))
+ (indent-to-column col) ;(make-string (- col (current-column)) ?\s))
(beginning-of-line 2)
(and (< (point) end)
(re-search-forward search end t)
HCoop / bpt / emacs.git / blobdiff