X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/d8fb8cce84b923a3289b69549e30958710ac3ebb..0877d0dc24ee792b9b14592869ea1aa0934aee58:/lisp/progmodes/perl-mode.el diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el index 2ee7734e40..bd58a7300e 100644 --- a/lisp/progmodes/perl-mode.el +++ b/lisp/progmodes/perl-mode.el @@ -1,4 +1,4 @@ -;;; perl-mode.el --- Perl code editing commands for GNU Emacs +;;; perl-mode.el --- Perl code editing commands for GNU Emacs -*- coding: utf-8 -*- ;; Copyright (C) 1990, 1994, 2001-2013 Free Software Foundation, Inc. @@ -102,11 +102,6 @@ ;;; Code: - -(defvar font-lock-comment-face) -(defvar font-lock-doc-face) -(defvar font-lock-string-face) - (defgroup perl nil "Major mode for editing Perl code." :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces) @@ -119,16 +114,11 @@ (defvar perl-mode-map (let ((map (make-sparse-keymap))) - (define-key map "{" 'perl-electric-terminator) - (define-key map "}" 'perl-electric-terminator) - (define-key map ";" 'perl-electric-terminator) - (define-key map ":" 'perl-electric-terminator) (define-key map "\e\C-a" 'perl-beginning-of-function) (define-key map "\e\C-e" 'perl-end-of-function) (define-key map "\e\C-h" 'perl-mark-function) (define-key map "\e\C-q" 'perl-indent-exp) (define-key map "\177" 'backward-delete-char-untabify) - (define-key map "\t" 'perl-indent-command) map) "Keymap used in Perl mode.") @@ -158,16 +148,54 @@ (defvar perl-imenu-generic-expression '(;; Functions - (nil "^sub\\s-+\\([-A-Za-z0-9+_:]+\\)" 1) + (nil "^[ \t]*sub\\s-+\\([-A-Za-z0-9+_:]+\\)" 1) ;;Variables ("Variables" "^\\(?:my\\|our\\)\\s-+\\([$@%][-A-Za-z0-9+_:]+\\)\\s-*=" 1) - ("Packages" "^package\\s-+\\([-A-Za-z0-9+_:]+\\);" 1) + ("Packages" "^[ \t]*package\\s-+\\([-A-Za-z0-9+_:]+\\);" 1) ("Doc sections" "^=head[0-9][ \t]+\\(.*\\)" 1)) "Imenu generic expression for Perl mode. See `imenu-generic-expression'.") ;; Regexps updated with help from Tom Tromey and ;; Jim Campbell . +(defcustom perl-prettify-symbols t + "If non-nil, some symbols will be displayed using Unicode chars." + :type 'boolean) + +(defconst perl--prettify-symbols-alist + '(;;("andalso" . ?∧) ("orelse" . ?∨) ("as" . ?≡)("not" . ?¬) + ;;("div" . ?÷) ("*" . ?×) ("o" . ?○) + ("->" . ?→) + ("=>" . ?⇒) + ;;("<-" . ?←) ("<>" . ?≠) (">=" . ?≥) ("<=" . ?≤) ("..." . ?⋯) + ("::" . ?∷) + )) + +(defun perl--font-lock-compose-symbol () + "Compose a sequence of ascii chars into a symbol. +Regexp match data 0 points to the chars." + ;; Check that the chars should really be composed into a symbol. + (let* ((start (match-beginning 0)) + (end (match-end 0)) + (syntaxes (if (eq (char-syntax (char-after start)) ?w) + '(?w) '(?. ?\\)))) + (if (or (memq (char-syntax (or (char-before start) ?\ )) syntaxes) + (memq (char-syntax (or (char-after end) ?\ )) syntaxes) + (nth 8 (syntax-ppss))) + ;; No composition for you. Let's actually remove any composition + ;; we may have added earlier and which is now incorrect. + (remove-text-properties start end '(composition)) + ;; That's a symbol alright, so add the composition. + (compose-region start end (cdr (assoc (match-string 0) + perl--prettify-symbols-alist))))) + ;; Return nil because we're not adding any face property. + nil) + +(defun perl--font-lock-symbols-keywords () + (when perl-prettify-symbols + `((,(regexp-opt (mapcar 'car perl--prettify-symbols-alist) t) + (0 (perl--font-lock-compose-symbol)))))) + (defconst perl-font-lock-keywords-1 '(;; What is this for? ;;("\\(--- .* ---\\|=== .* ===\\)" . font-lock-string-face) @@ -190,32 +218,32 @@ "Subdued level highlighting for Perl mode.") (defconst perl-font-lock-keywords-2 - (append perl-font-lock-keywords-1 - (list - ;; - ;; Fontify keywords, except those fontified otherwise. - (concat "\\<" - (regexp-opt '("if" "until" "while" "elsif" "else" "unless" - "do" "dump" "for" "foreach" "exit" "die" - "BEGIN" "END" "return" "exec" "eval") t) - "\\>") - ;; - ;; Fontify local and my keywords as types. - '("\\<\\(local\\|my\\)\\>" . font-lock-type-face) - ;; - ;; Fontify function, variable and file name references. - '("&\\(\\sw+\\(::\\sw+\\)*\\)" 1 font-lock-function-name-face) - ;; Additionally underline non-scalar variables. Maybe this is a bad idea. - ;;'("[$@%*][#{]?\\(\\sw+\\)" 1 font-lock-variable-name-face) - '("[$*]{?\\(\\sw+\\(::\\sw+\\)*\\)" 1 font-lock-variable-name-face) - '("\\([@%]\\|\\$#\\)\\(\\sw+\\(::\\sw+\\)*\\)" + (append + perl-font-lock-keywords-1 + `( ;; Fontify keywords, except those fontified otherwise. + ,(concat "\\<" + (regexp-opt '("if" "until" "while" "elsif" "else" "unless" + "do" "dump" "for" "foreach" "exit" "die" + "BEGIN" "END" "return" "exec" "eval") t) + "\\>") + ;; + ;; Fontify local and my keywords as types. + ("\\<\\(local\\|my\\)\\>" . font-lock-type-face) + ;; + ;; Fontify function, variable and file name references. + ("&\\(\\sw+\\(::\\sw+\\)*\\)" 1 font-lock-function-name-face) + ;; Additionally underline non-scalar variables. Maybe this is a bad idea. + ;;'("[$@%*][#{]?\\(\\sw+\\)" 1 font-lock-variable-name-face) + ("[$*]{?\\(\\sw+\\(::\\sw+\\)*\\)" 1 font-lock-variable-name-face) + ("\\([@%]\\|\\$#\\)\\(\\sw+\\(::\\sw+\\)*\\)" (2 (cons font-lock-variable-name-face '(underline)))) - '("<\\(\\sw+\\)>" 1 font-lock-constant-face) - ;; - ;; Fontify keywords with/and labels as we do in `c++-font-lock-keywords'. - '("\\<\\(continue\\|goto\\|last\\|next\\|redo\\)\\>[ \t]*\\(\\sw+\\)?" + ("<\\(\\sw+\\)>" 1 font-lock-constant-face) + ;; + ;; Fontify keywords with/and labels as we do in `c++-font-lock-keywords'. + ("\\<\\(continue\\|goto\\|last\\|next\\|redo\\)\\>[ \t]*\\(\\sw+\\)?" (1 font-lock-keyword-face) (2 font-lock-constant-face nil t)) - '("^[ \t]*\\(\\sw+\\)[ \t]*:[^:]" 1 font-lock-constant-face))) + ("^[ \t]*\\(\\sw+\\)[ \t]*:[^:]" 1 font-lock-constant-face) + ,@(perl--font-lock-symbols-keywords))) "Gaudy level highlighting for Perl mode.") (defvar perl-font-lock-keywords perl-font-lock-keywords-1 @@ -543,11 +571,20 @@ create a new comment." (defun perl-outline-level () (cond - ((looking-at "package\\s-") 0) - ((looking-at "sub\\s-") 1) + ((looking-at "[ \t]*\\(package\\)\\s-") + (- (match-beginning 1) (match-beginning 0))) + ((looking-at "[ \t]*s\\(ub\\)\\s-") + (- (match-beginning 1) (match-beginning 0))) ((looking-at "=head[0-9]") (- (char-before (match-end 0)) ?0)) ((looking-at "=cut") 1) (t 3))) + +(defun perl-current-defun-name () + "The `add-log-current-defun' function in Perl mode." + (save-excursion + (if (re-search-backward "^sub[ \t]+\\([^({ \t\n]+\\)" nil t) + (match-string-no-properties 1)))) + (defvar perl-mode-hook nil "Normal hook to run when entering Perl mode.") @@ -601,15 +638,15 @@ Various indentation styles: K&R BSD BLK GNU LW Turning on Perl mode runs the normal hook `perl-mode-hook'." :abbrev-table perl-mode-abbrev-table - (set (make-local-variable 'paragraph-start) (concat "$\\|" page-delimiter)) - (set (make-local-variable 'paragraph-separate) paragraph-start) - (set (make-local-variable 'paragraph-ignore-fill-prefix) t) - (set (make-local-variable 'indent-line-function) #'perl-indent-line) - (set (make-local-variable 'comment-start) "# ") - (set (make-local-variable 'comment-end) "") - (set (make-local-variable 'comment-start-skip) "\\(^\\|\\s-\\);?#+ *") - (set (make-local-variable 'comment-indent-function) #'perl-comment-indent) - (set (make-local-variable 'parse-sexp-ignore-comments) t) + (setq-local paragraph-start (concat "$\\|" page-delimiter)) + (setq-local paragraph-separate paragraph-start) + (setq-local paragraph-ignore-fill-prefix t) + (setq-local indent-line-function #'perl-indent-line) + (setq-local comment-start "# ") + (setq-local comment-end "") + (setq-local comment-start-skip "\\(^\\|\\s-\\);?#+ *") + (setq-local comment-indent-function #'perl-comment-indent) + (setq-local parse-sexp-ignore-comments t) ;; Tell font-lock.el how to handle Perl. (setq font-lock-defaults '((perl-font-lock-keywords perl-font-lock-keywords-1 @@ -617,17 +654,21 @@ Turning on Perl mode runs the normal hook `perl-mode-hook'." nil nil ((?\_ . "w")) nil (font-lock-syntactic-face-function . perl-font-lock-syntactic-face-function))) - (set (make-local-variable 'syntax-propertize-function) - #'perl-syntax-propertize-function) + (setq-local syntax-propertize-function #'perl-syntax-propertize-function) (add-hook 'syntax-propertize-extend-region-functions #'syntax-propertize-multiline 'append 'local) + ;; Electricity. + ;; FIXME: setup electric-layout-rules. + (setq-local electric-indent-chars + (append '(?\{ ?\} ?\; ?\:) electric-indent-chars)) + (add-hook 'electric-indent-functions #'perl-electric-noindent-p nil t) ;; Tell imenu how to handle Perl. - (set (make-local-variable 'imenu-generic-expression) - perl-imenu-generic-expression) + (setq-local imenu-generic-expression perl-imenu-generic-expression) (setq imenu-case-fold-search nil) ;; Setup outline-minor-mode. - (set (make-local-variable 'outline-regexp) perl-outline-regexp) - (set (make-local-variable 'outline-level) 'perl-outline-level)) + (setq-local outline-regexp perl-outline-regexp) + (setq-local outline-level 'perl-outline-level) + (setq-local add-log-current-defun-function #'perl-current-defun-name)) ;; This is used by indent-for-comment ;; to decide how much to indent a comment in Perl code @@ -637,7 +678,11 @@ Turning on Perl mode runs the normal hook `perl-mode-hook'." 0 ;Existing comment at bol stays there. comment-column)) -(defalias 'electric-perl-terminator 'perl-electric-terminator) +(define-obsolete-function-alias 'electric-perl-terminator + 'perl-electric-terminator "22.1") +(defun perl-electric-noindent-p (char) + (unless (eolp) 'no-indent)) + (defun perl-electric-terminator (arg) "Insert character and maybe adjust indentation. If at end-of-line, and not in a comment or a quote, correct the indentation." @@ -661,6 +706,7 @@ If at end-of-line, and not in a comment or a quote, correct the indentation." (perl-indent-line) (delete-char -1)))) (self-insert-command (prefix-numeric-value arg))) +(make-obsolete 'perl-electric-terminator 'electric-indent-mode "24.4") ;; not used anymore, but may be useful someday: ;;(defun perl-inside-parens-p () @@ -744,6 +790,7 @@ following list: (t (message "Use backslash to quote # characters.") (ding t))))))))) +(make-obsolete 'perl-indent-command 'indent-according-to-mode "24.4") (defun perl-indent-line (&optional nochange parse-start) "Indent current line as Perl code.