;; 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
;; 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
(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.
(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)))))
(font-lock-prepend-text-property
from
to
- 'face
+ 'font-lock-face
(append (if boldp
'(erc-bold-face)
nil)
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)
(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")
(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")
(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
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)
(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
(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
(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
(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)))
'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
(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
(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 ()
(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
(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)))
(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)
(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)))
(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)))
(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))
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)))))
--- /dev/null
+;;; 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)) ))