From: Vivek Dasmohapatra Date: Thu, 7 Apr 2016 12:23:18 +0000 (+0200) Subject: Prefer 'font-lock-face to 'face in erc where appropriate X-Git-Tag: emacs-26.0.90~2237 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=badf7369a63e03a5f4f3817be10763611a6aa8a2;p=emacs.git Prefer 'font-lock-face to 'face in erc where appropriate * lisp/erc/erc-button.el (erc-button-add-face): Prefer 'font-lock-face to 'face where appropriate. * lisp/erc/erc-capab.el (erc-capab-identify-add-prefix) * lisp/erc/erc-dcc.el (erc-dcc-chat-parse-output) * lisp/erc/erc-goodies.el (erc-controls-propertize) * lisp/erc/erc-stamp.el (erc-format-timestamp) * lisp/erc/erc-track.el (erc-faces-in) * lisp/erc/erc.el (erc-load-irc-script-lines, erc-display-msg) (erc-display-command, erc-make-notice, erc-highlight-notice) (erc-format-my-nick, erc-format-@nick, erc-format-privmessage) (erc-display-prompt, erc-display-message-highlight) (erc-log-irc-protocol): Ditto. * test/lisp/erc/erc-track-tests.el: Converted asserts into ert tests. --- diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el index 7d509196330..f63ac17ab47 100644 --- a/lisp/erc/erc-button.el +++ b/lisp/erc/erc-button.el @@ -390,9 +390,9 @@ REGEXP is the regular expression which matched for this button." ;; merged correctly. If we use overlays, then redisplay will be ;; very slow with lots of buttons. This is why we manually merge ;; face text properties. - (let ((old (erc-list (get-text-property from 'face))) + (let ((old (erc-list (get-text-property from 'font-lock-face))) (pos from) - (end (next-single-property-change from 'face nil to)) + (end (next-single-property-change from 'font-lock-face nil to)) new) ;; old is the face at pos, in list form. It is nil if there is no ;; face at pos. If nil, the new face is FACE. If not nil, the @@ -400,10 +400,10 @@ REGEXP is the regular expression which matched for this button." ;; where this face changes. (while (< pos to) (setq new (if old (cons face old) face)) - (put-text-property pos end 'face new) + (put-text-property pos end 'font-lock-face new) (setq pos end - old (erc-list (get-text-property pos 'face)) - end (next-single-property-change pos 'face nil to))))) + old (erc-list (get-text-property pos 'font-lock-face)) + end (next-single-property-change pos 'font-lock-face nil to))))) ;; widget-button-click calls with two args, we ignore the first. ;; Since Emacs runs this directly, rather than with diff --git a/lisp/erc/erc-capab.el b/lisp/erc/erc-capab.el index 4b956cc01ac..1a93e212100 100644 --- a/lisp/erc/erc-capab.el +++ b/lisp/erc/erc-capab.el @@ -191,7 +191,8 @@ PARSED is an `erc-parsed' response struct." (re-search-forward (regexp-quote nickname) nil t)) (goto-char (match-beginning 0)) (insert (erc-propertize erc-capab-identify-prefix - 'face 'erc-capab-identify-unidentified)))))) + 'font-lock-face + 'erc-capab-identify-unidentified)))))) (defun erc-capab-identify-get-unidentified-nickname (parsed) "Return the nickname of the user if unidentified. diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el index 1bf380d47d1..9152527d4be 100644 --- a/lisp/erc/erc-dcc.el +++ b/lisp/erc/erc-dcc.el @@ -1205,7 +1205,7 @@ other client." (setq posn (match-end 0)) (erc-display-message nil nil proc - 'dcc-chat-privmsg ?n (erc-propertize erc-dcc-from 'face + 'dcc-chat-privmsg ?n (erc-propertize erc-dcc-from 'font-lock-face 'erc-nick-default-face) ?m line)) (setq erc-dcc-unprocessed-output (substring str posn))))) diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index 2a1d18720aa..afe8c555ce3 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -475,7 +475,7 @@ to a region in the current buffer." (font-lock-prepend-text-property from to - 'face + 'font-lock-face (append (if boldp '(erc-bold-face) nil) diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el index 1313ecc6072..4104a433995 100644 --- a/lisp/erc/erc-match.el +++ b/lisp/erc/erc-match.el @@ -486,7 +486,7 @@ Use this defun with `erc-insert-modify-hook'." nick-end) (erc-put-text-property nick-beg nick-end - 'face match-face (current-buffer))) + 'font-lock-face match-face (current-buffer))) ;; Highlight the nick of the message, or the current ;; nick if there's no nick in the message (e.g. /NAMES ;; output) @@ -495,17 +495,17 @@ Use this defun with `erc-insert-modify-hook'." (if nick-end (erc-put-text-property nick-beg nick-end - 'face match-face (current-buffer)) + 'font-lock-face match-face (current-buffer)) (goto-char (+ 2 (or nick-end (point-min)))) (while (re-search-forward match-regex nil t) (erc-put-text-property (match-beginning 0) (match-end 0) - 'face match-face)))) + 'font-lock-face match-face)))) ;; Highlight the whole message ((eq match-htype 'all) (erc-put-text-property (point-min) (point-max) - 'face match-face (current-buffer))) + 'font-lock-face match-face (current-buffer))) ;; Highlight all occurrences of the word to be ;; highlighted. ((and (string= match-type "keyword") @@ -521,7 +521,7 @@ Use this defun with `erc-insert-modify-hook'." (while (re-search-forward regex nil t) (erc-put-text-property (match-beginning 0) (match-end 0) - 'face face)))) + 'font-lock-face face)))) match-regex)) ;; Highlight all occurrences of our nick. ((and (string= match-type "current-nick") @@ -530,7 +530,7 @@ Use this defun with `erc-insert-modify-hook'." (point-min)))) (while (re-search-forward match-regex nil t) (erc-put-text-property (match-beginning 0) (match-end 0) - 'face match-face))) + 'font-lock-face match-face))) ;; Else twiddle your thumbs. (t nil)) (run-hook-with-args diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index a4c91ca9fb5..ee4e1d2fb6d 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -347,7 +347,8 @@ changed, it will then print it off to the right." Return the empty string if FORMAT is nil." (if format (let ((ts (format-time-string format time))) - (erc-put-text-property 0 (length ts) 'face 'erc-timestamp-face ts) + (erc-put-text-property 0 (length ts) + 'font-lock-face 'erc-timestamp-face ts) (erc-put-text-property 0 (length ts) 'invisible 'timestamp ts) (erc-put-text-property 0 (length ts) 'isearch-open-invisible 'timestamp ts) diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el index 4d8feb52759..a6d72d07d1d 100644 --- a/lisp/erc/erc-track.el +++ b/lisp/erc/erc-track.el @@ -480,99 +480,6 @@ START is the minimum length of the name used." (setq result other))) result)) -;;; Test: - -(cl-assert - (and - ;; verify examples from the doc strings - (equal (let ((erc-track-shorten-aggressively nil)) - (erc-unique-channel-names - '("#emacs" "#vi" "#electronica" "#folk") - '("#emacs" "#vi"))) - '("#em" "#vi")) ; emacs is different from electronica - (equal (let ((erc-track-shorten-aggressively t)) - (erc-unique-channel-names - '("#emacs" "#vi" "#electronica" "#folk") - '("#emacs" "#vi"))) - '("#em" "#v")) ; vi is shortened by one letter - (equal (let ((erc-track-shorten-aggressively 'max)) - (erc-unique-channel-names - '("#emacs" "#vi" "#electronica" "#folk") - '("#emacs" "#vi"))) - '("#e" "#v")) ; emacs need not be different from electronica - (equal (let ((erc-track-shorten-aggressively nil)) - (erc-unique-channel-names - '("#linux-de" "#linux-fr") - '("#linux-de" "#linux-fr"))) - '("#linux-de" "#linux-fr")) ; shortening by one letter is too aggressive - (equal (let ((erc-track-shorten-aggressively t)) - (erc-unique-channel-names - '("#linux-de" "#linux-fr") - '("#linux-de" "#linux-fr"))) - '("#linux-d" "#linux-f")); now we want to be aggressive - ;; specific problems - (equal (let ((erc-track-shorten-aggressively nil)) - (erc-unique-channel-names - '("#dunnet" "#lisp" "#sawfish" "#fsf" "#guile" - "#testgnome" "#gnu" "#fsbot" "#hurd" "#hurd-bunny" - "#emacs") - '("#hurd-bunny" "#hurd" "#sawfish" "#lisp"))) - '("#hurd-" "#hurd" "#s" "#l")) - (equal (let ((erc-track-shorten-aggressively nil)) - (erc-unique-substrings - '("#emacs" "#vi" "#electronica" "#folk"))) - '("#em" "#vi" "#el" "#f")) - (equal (let ((erc-track-shorten-aggressively t)) - (erc-unique-substrings - '("#emacs" "#vi" "#electronica" "#folk"))) - '("#em" "#v" "#el" "#f")) - (equal (let ((erc-track-shorten-aggressively nil)) - (erc-unique-channel-names - '("#emacs" "#burse" "+linux.de" "#starwars" - "#bitlbee" "+burse" "#ratpoison") - '("+linux.de" "#starwars" "#burse"))) - '("+l" "#s" "#bu")) - (equal (let ((erc-track-shorten-aggressively nil)) - (erc-unique-channel-names - '("fsbot" "#emacs" "deego") - '("fsbot"))) - '("fs")) - (equal (let ((erc-track-shorten-aggressively nil)) - (erc-unique-channel-names - '("fsbot" "#emacs" "deego") - '("fsbot") - (lambda (s) - (> (length s) 4)) - 1)) - '("f")) - (equal (let ((erc-track-shorten-aggressively nil)) - (erc-unique-channel-names - '("fsbot" "#emacs" "deego") - '("fsbot") - (lambda (s) - (> (length s) 4)) - 2)) - '("fs")) - (let ((erc-track-shorten-aggressively nil)) - (equal (erc-unique-channel-names '("deego" "#hurd" "#hurd-bunny" "#emacs") - '("#hurd" "#hurd-bunny")) - '("#hurd" "#hurd-"))) - ;; general examples - (let ((erc-track-shorten-aggressively t)) - (and (equal (erc-unique-substring-1 "abc" '("ab" "abcd")) "abcd") - (not (erc-unique-substring-1 "a" '("xyz" "xab"))) - (equal (erc-unique-substrings '("abc" "xyz" "xab")) - '("ab" "xy" "xa")) - (equal (erc-unique-substrings '("abc" "abcdefg")) - '("abc" "abcd")))) - (let ((erc-track-shorten-aggressively nil)) - (and (equal (erc-unique-substring-1 "abc" '("ab" "abcd")) "abcd") - (not (erc-unique-substring-1 "a" '("xyz" "xab"))) - (equal (erc-unique-substrings '("abc" "xyz" "xab")) - '("abc" "xyz" "xab")) - (equal (erc-unique-substrings '("abc" "abcdefg")) - '("abc" "abcd")))))) - ;;; Minor mode ;; Play nice with other IRC clients (and Emacs development rules) by @@ -981,13 +888,6 @@ is in `erc-mode'." (push cur faces))) faces)) -(cl-assert - (let ((str "is bold")) - (put-text-property 3 (length str) - 'face '(bold erc-current-nick-face) - str) - (erc-faces-in str))) - ;;; Buffer switching (defvar erc-track-last-non-erc-buffer nil diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 52adec1ce46..b20a6c9e966 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2276,7 +2276,7 @@ and appears in face `erc-input-face' in the buffer." (aref string (1- (length string)))) "\n")) - 'face 'erc-input-face))))) + 'font-lock-face 'erc-input-face))))) (let ((orig-win (selected-window)) (debug-buffer-window (get-buffer-window (current-buffer) t))) (when debug-buffer-window @@ -2466,9 +2466,9 @@ See also `erc-make-notice'." (t (erc-put-text-property 0 (length string) - 'face (or (intern-soft - (concat "erc-" (symbol-name type) "-face")) - "erc-default-face") + 'font-lock-face (or (intern-soft + (concat "erc-" (symbol-name type) "-face")) + "erc-default-face") string) string))) @@ -3897,7 +3897,7 @@ If FACE is non-nil, it will be used to propertize the prompt. If it is nil, 'front-sticky t 'read-only t)) (erc-put-text-property 0 (1- (length prompt)) - 'face (or face 'erc-prompt-face) + 'font-lock-face (or face 'erc-prompt-face) prompt) (insert prompt)) ;; Set the input marker @@ -4260,11 +4260,11 @@ and as second argument the event parsed as a vector." (nick-face (if privp 'erc-nick-msg-face 'erc-nick-default-face)) (msg-face (if privp 'erc-direct-msg-face 'erc-default-face))) ;; add text properties to text before the nick, the nick and after the nick - (erc-put-text-property 0 (length mark-s) 'face msg-face str) + (erc-put-text-property 0 (length mark-s) 'font-lock-face msg-face str) (erc-put-text-property (length mark-s) (+ (length mark-s) (length nick)) - 'face nick-face str) + 'font-lock-face nick-face str) (erc-put-text-property (+ (length mark-s) (length nick)) (length str) - 'face msg-face str) + 'font-lock-face msg-face str) str)) (defcustom erc-format-nick-function 'erc-format-nick @@ -4301,7 +4301,7 @@ also `erc-format-nick-function'." (let ((nick (erc-server-user-nickname user))) (concat (erc-propertize (erc-get-user-mode-prefix nick) - 'face 'erc-nick-prefix-face) + 'font-lock-face 'erc-nick-prefix-face) nick)))) (defun erc-format-my-nick () @@ -4312,12 +4312,12 @@ also `erc-format-nick-function'." (nick (erc-current-nick)) (mode (erc-get-user-mode-prefix nick))) (concat - (erc-propertize open 'face 'erc-default-face) - (erc-propertize mode 'face 'erc-my-nick-prefix-face) - (erc-propertize nick 'face 'erc-my-nick-face) - (erc-propertize close 'face 'erc-default-face))) + (erc-propertize open 'font-lock-face 'erc-default-face) + (erc-propertize mode 'font-lock-face 'erc-my-nick-prefix-face) + (erc-propertize nick 'font-lock-face 'erc-my-nick-face) + (erc-propertize close 'font-lock-face 'erc-default-face))) (let ((prefix "> ")) - (erc-propertize prefix 'face 'erc-default-face)))) + (erc-propertize prefix 'font-lock-face 'erc-default-face)))) (defun erc-echo-notice-in-default-buffer (s parsed buffer _sender) "Echos a private notice in the default buffer, namely the @@ -5238,10 +5238,10 @@ See also variable `erc-notice-highlight-type'." (cond ((eq erc-notice-highlight-type 'prefix) (erc-put-text-property 0 (length erc-notice-prefix) - 'face 'erc-notice-face s) + 'font-lock-face 'erc-notice-face s) s) ((eq erc-notice-highlight-type 'all) - (erc-put-text-property 0 (length s) 'face 'erc-notice-face s) + (erc-put-text-property 0 (length s) 'font-lock-face 'erc-notice-face s) s) (t s))) @@ -5253,7 +5253,7 @@ See also variable `erc-notice-highlight-type'." (defun erc-highlight-error (s) "Highlight error message S and return it." - (erc-put-text-property 0 (length s) 'face 'erc-error-face s) + (erc-put-text-property 0 (length s) 'font-lock-face 'erc-error-face s) s) (defun erc-put-text-property (start end property value &optional object) @@ -5443,7 +5443,7 @@ This returns non-nil only if we actually send anything." (let ((beg (point))) (insert line) (erc-put-text-property beg (point) - 'face 'erc-command-indicator-face) + 'font-lock-face 'erc-command-indicator-face) (insert "\n")) (when (processp erc-server-process) (set-marker (process-mark erc-server-process) (point))) @@ -5463,7 +5463,7 @@ current position." (let ((beg (point))) (insert line) (erc-put-text-property beg (point) - 'face 'erc-input-face)) + 'font-lock-face 'erc-input-face)) (insert "\n") (when (processp erc-server-process) (set-marker (process-mark erc-server-process) (point))) @@ -5887,7 +5887,7 @@ user input." (setq args (substring args 1))) ;; prepare the prompt string for echo (erc-put-text-property 0 (length sp) - 'face 'erc-command-indicator-face sp) + 'font-lock-face 'erc-command-indicator-face sp) (while lines (setq s (car lines)) (erc-log (concat "erc-load-script: CMD: " s)) @@ -5897,7 +5897,7 @@ user input." erc-script-echo) (progn (erc-put-text-property 0 (length line) - 'face 'erc-input-face line) + 'font-lock-face 'erc-input-face line) (erc-display-line (concat sp line) cb))))) (setq lines (cdr lines))))) diff --git a/test/lisp/erc/erc-track-tests.el b/test/lisp/erc/erc-track-tests.el new file mode 100644 index 00000000000..8e39e1b9887 --- /dev/null +++ b/test/lisp/erc/erc-track-tests.el @@ -0,0 +1,118 @@ +;;; erc-track-tests.el --- Tests for erc-track. + +;; Copyright © 2016 Free Software Foundation, Inc. + +;; Author: Mario Lang +;; Author: Vivek Das Mohapatra + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Code: + +(require 'ert) +(require 'erc-track) + +(ert-deftest erc-track--shorten-aggressive-nil () + "Test non-aggressive erc track buffer name shortening." + (let (erc-track-shorten-aggressively) + (should + (equal (erc-unique-channel-names '("#emacs" "#vi" "#electronica" "#folk") + '("#emacs" "#vi")) + '("#em" "#vi"))) + (should + (equal (erc-unique-channel-names '("#linux-de" "#linux-fr") + '("#linux-de" "#linux-fr")) + '("#linux-de" "#linux-fr"))) + (should + (equal (erc-unique-channel-names + '("#dunnet" "#lisp" "#sawfish" "#fsf" "#guile" "#testgnome" + "#gnu" "#fsbot" "#hurd" "#hurd-bunny" "#emacs") + '("#hurd-bunny" "#hurd" "#sawfish" "#lisp")) + '("#hurd-" "#hurd" "#s" "#l"))) + (should + (equal (erc-unique-substrings '("#emacs" "#vi" "#electronica" "#folk")) + '("#em" "#vi" "#el" "#f"))) + (should + (equal (erc-unique-channel-names + '("#emacs" "#burse" "+linux.de" "#starwars" + "#bitlbee" "+burse" "#ratpoison") + '("+linux.de" "#starwars" "#burse")) + '("+l" "#s" "#bu"))) + (should + (equal (erc-unique-channel-names '("fsbot" "#emacs" "deego") '("fsbot")) + '("fs"))) + (should + (equal (erc-unique-channel-names '("fsbot" "#emacs" "deego") + '("fsbot") + (lambda (s) (> (length s) 4)) 1) + '("f"))) + (should + (equal (erc-unique-channel-names '("fsbot" "#emacs" "deego") + '("fsbot") + (lambda (s) (> (length s) 4)) 2) + '("fs"))) + (should + (equal (erc-unique-channel-names '("deego" "#hurd" "#hurd-bunny" "#emacs") + '("#hurd" "#hurd-bunny")) + '("#hurd" "#hurd-"))) + (should + (and + (equal (erc-unique-substring-1 "abc" '("ab" "abcd")) "abcd") + (not (erc-unique-substring-1 "a" '("xyz" "xab"))) + (equal (erc-unique-substrings '("abc" "xyz" "xab")) '("abc" "xyz" "xab")) + (equal (erc-unique-substrings '("abc" "abcdefg")) '("abc" "abcd")))) )) + +(ert-deftest erc-track--shorten-aggressive-t () + "Test aggressive erc track buffer name shortening." + (let ((erc-track-shorten-aggressively t)) + (should + (equal (erc-unique-channel-names '("#emacs" "#vi" "#electronica" "#folk") + '("#emacs" "#vi")) + '("#em" "#v"))) + (should + (equal (erc-unique-channel-names '("#linux-de" "#linux-fr") + '("#linux-de" "#linux-fr")) + '("#linux-d" "#linux-f"))) + (should + (equal (erc-unique-substrings '("#emacs" "#vi" "#electronica" "#folk")) + '("#em" "#v" "#el" "#f"))) + (should + (and + (equal (erc-unique-substring-1 "abc" '("ab" "abcd")) "abcd") + (not (erc-unique-substring-1 "a" '("xyz" "xab"))) + (equal (erc-unique-substrings '("abc" "xyz" "xab")) '("ab" "xy" "xa")) + (equal (erc-unique-substrings '("abc" "abcdefg")) '("abc" "abcd")))) )) + +(ert-deftest erc-track--shorten-aggressive-max () + "Test maximally aggressive erc track buffer name shortening." + (let ((erc-track-shorten-aggressively 'max)) + (should + (equal (erc-unique-channel-names '("#emacs" "#vi" "#electronica" "#folk") + '("#emacs" "#vi")) + '("#e" "#v"))) )) + +(ert-deftest erc-track--erc-faces-in () + "`erc-faces-in' should pick up both 'face and 'font-lock-face properties." + (let ((str0 "is bold") + (str1 "is bold") + ;;(char-property-alias-alist '((face font-lock-face))) + ) + (put-text-property 3 (length str0) 'font-lock-face + '(bold erc-current-nick-face) str0) + (put-text-property 3 (length str1) 'face + '(bold erc-current-nick-face) str1) + (should (erc-faces-in str0)) + (should (erc-faces-in str1)) ))