/[emacs]/emacs/lisp/progmodes/perl-mode.el
ViewVC logotype

Diff of /emacs/lisp/progmodes/perl-mode.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.61 by monnier, Wed Sep 7 19:54:49 2005 UTC revision 1.62 by monnier, Wed Nov 2 17:33:28 2005 UTC
# Line 252  The expansion is entirely correct becaus Line 252  The expansion is entirely correct becaus
252  ;;  ;;
253  ;; <file*glob>  ;; <file*glob>
254  (defvar perl-font-lock-syntactic-keywords  (defvar perl-font-lock-syntactic-keywords
255    ;; Turn POD into b-style comments    ;; TODO: here-documents ("<<\\(\\sw\\|['\"]\\)")
256    '(("^\\(=\\)\\sw" (1 "< b"))    '(;; Turn POD into b-style comments
257        ("^\\(=\\)\\sw" (1 "< b"))
258      ("^=cut[ \t]*\\(\n\\)" (1 "> b"))      ("^=cut[ \t]*\\(\n\\)" (1 "> b"))
259      ;; Catch ${ so that ${var} doesn't screw up indentation.      ;; Catch ${ so that ${var} doesn't screw up indentation.
260      ;; This also catches $' to handle 'foo$', although it should really      ;; This also catches $' to handle 'foo$', although it should really
# Line 275  The expansion is entirely correct becaus Line 276  The expansion is entirely correct becaus
276       (3 (if (assoc (char-after (match-beginning 3))       (3 (if (assoc (char-after (match-beginning 3))
277                     perl-quote-like-pairs)                     perl-quote-like-pairs)
278              '(15) '(7))))              '(15) '(7))))
279      ;; TODO: here-documents ("<<\\(\\sw\\|['\"]\\)")      ;; Find and mark the end of funny quotes and format statements.
280        (perl-font-lock-special-syntactic-constructs)
281      ))      ))
282    
283  (defvar perl-empty-syntax-table  (defvar perl-empty-syntax-table
# Line 295  The expansion is entirely correct becaus Line 297  The expansion is entirely correct becaus
297        (modify-syntax-entry close ")" st))        (modify-syntax-entry close ")" st))
298      st))      st))
299    
300  (defun perl-font-lock-syntactic-face-function (state)  (defun perl-font-lock-special-syntactic-constructs (limit)
301    (let ((char (nth 3 state)))    ;; We used to do all this in a font-lock-syntactic-face-function, which
302      (cond    ;; did not work correctly because sometimes some parts of the buffer are
303       ((not char)    ;; treated with font-lock-syntactic-keywords but not with
304        ;; Comment or docstring.    ;; font-lock-syntactic-face-function (mostly because of
305        (if (nth 7 state) font-lock-doc-face font-lock-comment-face))    ;; font-lock-syntactically-fontified).  That meant that some syntax-table
306       ((and (char-valid-p char) (eq (char-syntax (nth 3 state)) ?\"))    ;; properties were missing.  So now we do the parse-partial-sexp loop
307        ;; Normal string.    ;; ourselves directly from font-lock-syntactic-keywords, so we're sure
308        font-lock-string-face)    ;; it's done when necessary.
309       ((eq (nth 3 state) ?\n)    (let ((state (syntax-ppss))
310        ;; A `format' command.          char)
311        (save-excursion      (while (< (point) limit)
312          (when (and (re-search-forward "^\\s *\\.\\s *$" nil t)        (cond
313                     (not (eobp)))         ((or (null (setq char (nth 3 state)))
314            (put-text-property (point) (1+ (point)) 'syntax-table '(7)))              (and (char-valid-p char) (eq (char-syntax (nth 3 state)) ?\")))
315          font-lock-string-face))          ;; Normal text, or comment, or docstring, or normal string.
316       (t          nil)
317        ;; This is regexp like quote thingy.         ((eq (nth 3 state) ?\n)
318        (setq char (char-after (nth 8 state)))          ;; A `format' command.
319        (save-excursion          (save-excursion
320          (let ((twoargs (save-excursion            (when (and (re-search-forward "^\\s *\\.\\s *$" nil t)
321                           (goto-char (nth 8 state))                       (not (eobp)))
322                           (skip-syntax-backward " ")              (put-text-property (point) (1+ (point)) 'syntax-table '(7)))))
323                           (skip-syntax-backward "w")         (t
324                           (member (buffer-substring          ;; This is regexp like quote thingy.
325                                    (point) (progn (forward-word 1) (point)))          (setq char (char-after (nth 8 state)))
326                                   '("tr" "s" "y"))))          (save-excursion
327                (close (cdr (assq char perl-quote-like-pairs)))            (let ((twoargs (save-excursion
328                (pos (point))                             (goto-char (nth 8 state))
329                (st (perl-quote-syntax-table char)))                             (skip-syntax-backward " ")
330            (if (not close)                             (skip-syntax-backward "w")
331                ;; The closing char is the same as the opening char.                             (member (buffer-substring
332                (with-syntax-table st                                      (point) (progn (forward-word 1) (point)))
333                  (parse-partial-sexp (point) (point-max)                                     '("tr" "s" "y"))))
334                                      nil nil state 'syntax-table)                  (close (cdr (assq char perl-quote-like-pairs)))
335                  (when twoargs                  (pos (point))
336                    (parse-partial-sexp (point) (point-max)                  (st (perl-quote-syntax-table char)))
337                                        nil nil state 'syntax-table)))              (if (not close)
338              ;; The open/close chars are matched like () [] {} and <>.                  ;; The closing char is the same as the opening char.
339              (let ((parse-sexp-lookup-properties nil))                  (with-syntax-table st
340                (condition-case err                    (parse-partial-sexp (point) (point-max)
341                    (progn                                        nil nil state 'syntax-table)
342                      (with-syntax-table st                    (when twoargs
343                        (goto-char (nth 8 state)) (forward-sexp 1))                      (parse-partial-sexp (point) (point-max)
344                      (when twoargs                                          nil nil state 'syntax-table)))
345                        (save-excursion                ;; The open/close chars are matched like () [] {} and <>.
346                          ;; Skip whitespace and make sure that font-lock will                (let ((parse-sexp-lookup-properties nil))
347                          ;; refontify the second part in the proper context.                  (condition-case err
348                          (put-text-property                      (progn
349                           (point) (progn (forward-comment (point-max)) (point))                        (with-syntax-table st
350                           'font-lock-multiline t)                          (goto-char (nth 8 state)) (forward-sexp 1))
351                          ;;                        (when twoargs
352                          (unless                          (save-excursion
353                              (save-excursion                            ;; Skip whitespace and make sure that font-lock will
354                                (with-syntax-table                            ;; refontify the second part in the proper context.
355                                    (perl-quote-syntax-table (char-after))                            (put-text-property
356                                  (forward-sexp 1))                             (point) (progn (forward-comment (point-max)) (point))
357                                (put-text-property pos (line-end-position)                             'font-lock-multiline t)
358                                                   'jit-lock-defer-multiline t)                            ;;
359                                (looking-at "\\s-*\\sw*e"))                            (unless
360                            (put-text-property (point) (1+ (point))                                (save-excursion
361                                               'syntax-table                                  (with-syntax-table
362                                               (if (assoc (char-after)                                      (perl-quote-syntax-table (char-after))
363                                                          perl-quote-like-pairs)                                    (forward-sexp 1))
364                                                   '(15) '(7)))))))                                  (put-text-property pos (line-end-position)
365                  ;; The arg(s) is not terminated, so it extends until EOB.                                                     'jit-lock-defer-multiline t)
366                  (scan-error (goto-char (point-max))))))                                  (looking-at "\\s-*\\sw*e"))
367            ;; Point is now right after the arg(s).                              (put-text-property (point) (1+ (point))
368            ;; Erase any syntactic marks within the quoted text.                                                 'syntax-table
369            (put-text-property pos (1- (point)) 'syntax-table nil)                                                 (if (assoc (char-after)
370            (when (eq (char-before (1- (point))) ?$)                                                            perl-quote-like-pairs)
371              (put-text-property (- (point) 2) (1- (point))                                                     '(15) '(7)))))))
372                                 'syntax-table '(1)))                    ;; The arg(s) is not terminated, so it extends until EOB.
373            (put-text-property (1- (point)) (point)                    (scan-error (goto-char (point-max))))))
374                               'syntax-table (if close '(15) '(7)))              ;; Point is now right after the arg(s).
375            font-lock-string-face))))))              ;; Erase any syntactic marks within the quoted text.
376              ;; (if (or twoargs (not (looking-at "\\s-*\\sw*e")))              (put-text-property pos (1- (point)) 'syntax-table nil)
377              ;;  font-lock-string-face              (when (eq (char-before (1- (point))) ?$)
378              ;;   (font-lock-fontify-syntactically-region                (put-text-property (- (point) 2) (1- (point))
379              ;;    ;; FIXME: `end' is accessed via dyn-scoping.                                   'syntax-table '(1)))
380              ;;    pos (min end (1- (point))) nil '(nil))              (put-text-property (1- (point)) (point)
381              ;;   nil)))))))                                 'syntax-table (if close '(15) '(7)))))))
382    
383          (setq state (parse-partial-sexp (point) limit nil nil state
384                                          'syntax-table))))
385      ;; Tell font-lock that this needs not further processing.
386      nil)
387    
388    
389  (defcustom perl-indent-level 4  (defcustom perl-indent-level 4
# Line 531  Turning on Perl mode runs the normal hoo Line 538  Turning on Perl mode runs the normal hoo
538                               nil nil ((?\_ . "w")) nil                               nil nil ((?\_ . "w")) nil
539                               (font-lock-syntactic-keywords                               (font-lock-syntactic-keywords
540                                . perl-font-lock-syntactic-keywords)                                . perl-font-lock-syntactic-keywords)
                              (font-lock-syntactic-face-function  
                               . perl-font-lock-syntactic-face-function)  
541                               (parse-sexp-lookup-properties . t)))                               (parse-sexp-lookup-properties . t)))
542    ;; Tell imenu how to handle Perl.    ;; Tell imenu how to handle Perl.
543    (set (make-local-variable 'imenu-generic-expression)    (set (make-local-variable 'imenu-generic-expression)

Legend:
Removed from v.1.61  
changed lines
  Added in v.1.62

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26