Commit badf7369 authored by Vivek Dasmohapatra's avatar Vivek Dasmohapatra Committed by Lars Magne Ingebrigtsen

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.
parent 1f6b0bc1
......@@ -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
......
......@@ -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.
......
......@@ -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)))))
......
......@@ -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)
......
......@@ -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
......
......@@ -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)
......
......@@ -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
......
......@@ -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)))))
......
;;; erc-track-tests.el --- Tests for erc-track.
;; Copyright © 2016 Free Software Foundation, Inc.
;; Author: Mario Lang <mlang@delysid.org>
;; Author: Vivek Das Mohapatra <vivek@etla.org>
;; 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 <http://www.gnu.org/licenses/>.
;;; 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)) ))
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment