[Emacs-diffs] Changes to emacs/lisp/progmodes/cperl-mode.el

[Miles Bader]

Index: emacs/lisp/progmodes/cperl-mode.el
diff -c emacs/lisp/progmodes/cperl-mode.el:1.67 
emacs/lisp/progmodes/cperl-mode.el:1.68
*** emacs/lisp/progmodes/cperl-mode.el:1.67     Sun Jun 12 23:04:41 2005
--- emacs/lisp/progmodes/cperl-mode.el  Wed Jun 15 00:14:58 2005
***************
*** 564,574 ****
      (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)
      (font-lock-comment-face           nil "LightGray" italic)
      (font-lock-string-face            nil nil         italic underline)
!     (cperl-nonoverridable-face                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'."
--- 564,574 ----
      (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                      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             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'."
***************
*** 583,589 ****
  (defvar cperl-dark-foreground
    (cperl-choose-color "orchid1" "orange"))
  
! (defface cperl-nonoverridable-face
    `((((class grayscale) (background light))
       (:background "Gray90" :slant italic :underline t))
      (((class grayscale) (background dark))
--- 583,589 ----
  (defvar cperl-dark-foreground
    (cperl-choose-color "orchid1" "orange"))
  
! (defface cperl-nonoverridable
    `((((class grayscale) (background light))
       (:background "Gray90" :slant italic :underline t))
      (((class grayscale) (background dark))
***************
*** 595,602 ****
      (t (:weight bold :underline t)))
    "Font Lock mode face used non-overridable keywords and modifiers of 
regexps."
    :group 'cperl-faces)
  
! (defface cperl-array-face
    `((((class grayscale) (background light))
       (:background "Gray90" :weight bold))
      (((class grayscale) (background dark))
--- 595,604 ----
      (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
    `((((class grayscale) (background light))
       (:background "Gray90" :weight bold))
      (((class grayscale) (background dark))
***************
*** 608,615 ****
      (t (:weight bold)))
    "Font Lock mode face used to highlight array names."
    :group 'cperl-faces)
  
! (defface cperl-hash-face
    `((((class grayscale) (background light))
       (:background "Gray90" :weight bold :slant italic))
      (((class grayscale) (background dark))
--- 610,619 ----
      (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
    `((((class grayscale) (background light))
       (:background "Gray90" :weight bold :slant italic))
      (((class grayscale) (background dark))
***************
*** 621,626 ****
--- 625,632 ----
      (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)
  
  
  
***************
*** 867,874 ****
  (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
    `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
--- 873,880 ----
  (defvar cperl-tips-faces 'please-ignore-this-line
    "CPerl mode uses following faces for highlighting:
  
!   `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
***************
*** 879,885 ****
                                (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
    `font-lock-string-face'     Strings, qw() constructs, RExen, POD sections,
                                literal parts and the terminator of formats
                                and whatever is syntaxically considered
--- 885,891 ----
                                (except those conflicting with Perl operators),
                                package names (when recognized), format names
    `font-lock-keyword-face'    Control flow switch constructs, declarators
!   `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
***************
*** 887,893 ****
    `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
  
  Note that in several situations the highlighting tries to inform about
  possible confusion, such as different colors for function names in
--- 893,899 ----
    `font-lock-type-face'               Overridable keywords
    `font-lock-variable-name-face' Variable declarations, indirect array and
                                hash names, POD headers/item names
!   `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
***************
*** 3167,3173 ****
         (cperl-nonoverridable-face
          (if (boundp 'cperl-nonoverridable-face)
              cperl-nonoverridable-face
!           'cperl-nonoverridable-face))
         (stop-point (if ignore-max
                         (point-max)
                       max))
--- 3173,3179 ----
         (cperl-nonoverridable-face
          (if (boundp 'cperl-nonoverridable-face)
              cperl-nonoverridable-face
!           'cperl-nonoverridable))
         (stop-point (if ignore-max
                         (point-max)
                       max))
***************
*** 3661,3667 ****
                        (forward-word 1) ; skip modifiers s///s
                        (if tail (cperl-commentify tail (point) t))
                        (cperl-postpone-fontification
!                        e1 (point) 'face 'cperl-nonoverridable-face)))
                  ;; Check whether it is m// which means "previous match"
                  ;; and highlight differently
                  (setq is-REx
--- 3667,3673 ----
                        (forward-word 1) ; skip modifiers s///s
                        (if tail (cperl-commentify tail (point) t))
                        (cperl-postpone-fontification
!                        e1 (point) 'face 'cperl-nonoverridable)))
                  ;; Check whether it is m// which means "previous match"
                  ;; and highlight differently
                  (setq is-REx
***************
*** 4710,4716 ****
              "u\\(se\\|n\\(shift\\|ti\\(l\\|e\\)\\|def\\|less\\)\\)\\|"
              "while\\|y\\|__\\(END\\|DATA\\)__" ;__DATA__ added manually
              "\\|[sm]"                 ; Added manually
!             "\\)\\>") 2 'cperl-nonoverridable-face)
            ;;          (mapconcat 'identity
            ;;                     '("#endif" "#else" "#ifdef" "#ifndef" "#if"
            ;;                       "#include" "#define" "#undef")
--- 4716,4722 ----
              "u\\(se\\|n\\(shift\\|ti\\(l\\|e\\)\\|def\\|less\\)\\)\\|"
              "while\\|y\\|__\\(END\\|DATA\\)__" ;__DATA__ added manually
              "\\|[sm]"                 ; Added manually
!             "\\)\\>") 2 'cperl-nonoverridable)
            ;;          (mapconcat 'identity
            ;;                     '("#endif" "#else" "#ifdef" "#ifndef" "#if"
            ;;                       "#include" "#define" "#undef")
***************
*** 4854,4874 ****
                      [nil              nil             t               t       
t]
                      nil
                      [nil              nil             t               t       
t])
!               (list 'cperl-nonoverridable-face
                      ["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
                      ["blue"           "yellow"        nil             
"Gray80"]
                      ["lightyellow2"   ("navy" "os2blue" "darkgreen")
                       "gray90"]
                      t
                      nil
                      nil)
!               (list 'cperl-hash-face
                      ["red"            "red"           nil             
"Gray80"]
                      ["lightyellow2"   ("navy" "os2blue" "darkgreen")
                       "gray90"]
--- 4860,4880 ----
                      [nil              nil             t               t       
t]
                      nil
                      [nil              nil             t               t       
t])
!               (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
                      ["blue"           "yellow"        nil             
"Gray80"]
                      ["lightyellow2"   ("navy" "os2blue" "darkgreen")
                       "gray90"]
                      t
                      nil
                      nil)
!               (list 'cperl-hash
                      ["red"            "red"           nil             
"Gray80"]
                      ["lightyellow2"   ("navy" "os2blue" "darkgreen")
                       "gray90"]
***************
*** 4891,4905 ****
                            "Face for variable names")
          (cperl-force-face font-lock-type-face
                            "Face for data types")
!         (cperl-force-face cperl-nonoverridable-face
                            "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
                            "Face for hashes")
!         (cperl-force-face cperl-array-face
                            "Face for arrays")
          ;;(defvar font-lock-constant-face 'font-lock-constant-face)
          ;;(defvar font-lock-variable-name-face 'font-lock-variable-name-face)
--- 4897,4911 ----
                            "Face for variable names")
          (cperl-force-face font-lock-type-face
                            "Face for data types")
!         (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 for hashes")
!         (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)
***************
*** 4909,4915 ****
          ;;    "Face to use for data types."))
          ;;(or (boundp 'cperl-nonoverridable-face)
          ;;    (defconst cperl-nonoverridable-face
!         ;;    'cperl-nonoverridable-face
          ;;    "Face to use for data types from another group."))
          ;;(if (not cperl-xemacs-p) nil
          ;;  (or (boundp 'font-lock-comment-face)
--- 4915,4921 ----
          ;;    "Face to use for data types."))
          ;;(or (boundp 'cperl-nonoverridable-face)
          ;;    (defconst 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)
***************
*** 4925,4950 ****
          ;;      'font-lock-function-name-face
          ;;      "Face to use for function names.")))
          (if (and
!              (not (cperl-is-face 'cperl-array-face))
               (cperl-is-face 'font-lock-emphasized-face))
!             (copy-face 'font-lock-emphasized-face 'cperl-array-face))
          (if (and
!              (not (cperl-is-face 'cperl-hash-face))
               (cperl-is-face 'font-lock-other-emphasized-face))
!             (copy-face 'font-lock-other-emphasized-face
!                        'cperl-hash-face))
          (if (and
!              (not (cperl-is-face 'cperl-nonoverridable-face))
               (cperl-is-face 'font-lock-other-type-face))
!             (copy-face 'font-lock-other-type-face
!                        'cperl-nonoverridable-face))
          ;;(or (boundp 'cperl-hash-face)
          ;;    (defconst cperl-hash-face
!         ;;    'cperl-hash-face
          ;;    "Face to use for hashes."))
          ;;(or (boundp 'cperl-array-face)
          ;;    (defconst cperl-array-face
!         ;;    'cperl-array-face
          ;;    "Face to use for arrays."))
          ;; Here we try to guess background
          (let ((background
--- 4931,4954 ----
          ;;      'font-lock-function-name-face
          ;;      "Face to use for function names.")))
          (if (and
!              (not (cperl-is-face 'cperl-array))
               (cperl-is-face 'font-lock-emphasized-face))
!             (copy-face 'font-lock-emphasized-face 'cperl-array))
          (if (and
!              (not (cperl-is-face 'cperl-hash))
               (cperl-is-face 'font-lock-other-emphasized-face))
!             (copy-face 'font-lock-other-emphasized-face 'cperl-hash))
          (if (and
!              (not (cperl-is-face 'cperl-nonoverridable))
               (cperl-is-face 'font-lock-other-type-face))
!             (copy-face 'font-lock-other-type-face 'cperl-nonoverridable))
          ;;(or (boundp 'cperl-hash-face)
          ;;    (defconst cperl-hash-face
!         ;;    'cperl-hash
          ;;    "Face to use for hashes."))
          ;;(or (boundp 'cperl-array-face)
          ;;    (defconst cperl-array-face
!         ;;    'cperl-array
          ;;    "Face to use for arrays."))
          ;; Here we try to guess background
          (let ((background
***************
*** 4983,4999 ****
                                       "pink")))
               (t
                (set-face-background 'font-lock-type-face "gray90"))))
!           (if (cperl-is-face 'cperl-nonoverridable-face)
                nil
!             (copy-face 'font-lock-type-face 'cperl-nonoverridable-face)
              (cond
               ((eq background 'light)
!               (set-face-foreground 'cperl-nonoverridable-face
                                     (if (x-color-defined-p "chartreuse3")
                                         "chartreuse3"
                                       "chartreuse")))
               ((eq background 'dark)
!               (set-face-foreground 'cperl-nonoverridable-face
                                     (if (x-color-defined-p "orchid1")
                                         "orchid1"
                                       "orange")))))
--- 4987,5003 ----
                                       "pink")))
               (t
                (set-face-background 'font-lock-type-face "gray90"))))
!           (if (cperl-is-face 'cperl-nonoverridable)
                nil
!             (copy-face 'font-lock-type-face 'cperl-nonoverridable)
              (cond
               ((eq background 'light)
!               (set-face-foreground 'cperl-nonoverridable
                                     (if (x-color-defined-p "chartreuse3")
                                         "chartreuse3"
                                       "chartreuse")))
               ((eq background 'dark)
!               (set-face-foreground 'cperl-nonoverridable
                                     (if (x-color-defined-p "orchid1")
                                         "orchid1"
                                       "orange")))))
***************
*** 5045,5064 ****
      '(setq ps-bold-faces
           ;;                   font-lock-variable-name-face
           ;;                   font-lock-constant-face
!          (append '(cperl-array-face
!                    cperl-hash-face)
                   ps-bold-faces)
           ps-italic-faces
           ;;                   font-lock-constant-face
!          (append '(cperl-nonoverridable-face
!                    cperl-hash-face)
                   ps-italic-faces)
           ps-underlined-faces
           ;;        font-lock-type-face
!          (append '(cperl-array-face
!                    cperl-hash-face
!                    underline
!                    cperl-nonoverridable-face)
                   ps-underlined-faces))))
  
  (defvar ps-print-face-extension-alist)
--- 5049,5063 ----
      '(setq ps-bold-faces
           ;;                   font-lock-variable-name-face
           ;;                   font-lock-constant-face
!          (append '(cperl-array cperl-hash)
                   ps-bold-faces)
           ps-italic-faces
           ;;                   font-lock-constant-face
!          (append '(cperl-nonoverridable cperl-hash)
                   ps-italic-faces)
           ps-underlined-faces
           ;;        font-lock-type-face
!          (append '(cperl-array cperl-hash underline cperl-nonoverridable)
                   ps-underlined-faces))))
  
  (defvar ps-print-face-extension-alist)
***************
*** 5091,5117 ****
  ;;;   (defvar ps-italic-faces nil)
  ;;;   (setq ps-bold-faces
  ;;;   (append '(font-lock-emphasized-face
! ;;;             cperl-array-face
  ;;;             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)
  ;;;           ps-bold-faces))
  ;;;   (setq ps-italic-faces
! ;;;   (append '(cperl-nonoverridable-face
  ;;;             font-lock-constant-face
  ;;;             font-lock-reference-face
  ;;;             font-lock-other-emphasized-face
! ;;;             cperl-hash-face)
  ;;;           ps-italic-faces))
  ;;;   (setq ps-underlined-faces
  ;;;   (append '(font-lock-emphasized-face
! ;;;             cperl-array-face
  ;;;             font-lock-other-emphasized-face
! ;;;             cperl-hash-face
! ;;;             cperl-nonoverridable-face font-lock-type-face)
  ;;;           ps-underlined-faces))
  ;;;   (cons 'font-lock-type-face ps-underlined-faces))
  
--- 5090,5116 ----
  ;;;   (defvar ps-italic-faces nil)
  ;;;   (setq ps-bold-faces
  ;;;   (append '(font-lock-emphasized-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)
  ;;;           ps-bold-faces))
  ;;;   (setq ps-italic-faces
! ;;;   (append '(cperl-nonoverridable
  ;;;             font-lock-constant-face
  ;;;             font-lock-reference-face
  ;;;             font-lock-other-emphasized-face
! ;;;             cperl-hash)
  ;;;           ps-italic-faces))
  ;;;   (setq ps-underlined-faces
  ;;;   (append '(font-lock-emphasized-face
! ;;;             cperl-array
  ;;;             font-lock-other-emphasized-face
! ;;;             cperl-hash
! ;;;             cperl-nonoverridable font-lock-type-face)
  ;;;           ps-underlined-faces))
  ;;;   (cons 'font-lock-type-face ps-underlined-faces))