From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Ryan Yeske Newsgroups: gmane.emacs.devel Subject: rcirc face updates and bug fixes Date: Thu, 17 Nov 2005 00:13:37 -0800 Message-ID: <871x1f3d5a.fsf@cut.bc.hsia.telus.net> NNTP-Posting-Host: main.gmane.org X-Trace: sea.gmane.org 1132218760 20867 80.91.229.2 (17 Nov 2005 09:12:40 GMT) X-Complaints-To: usenet@sea.gmane.org NNTP-Posting-Date: Thu, 17 Nov 2005 09:12:40 +0000 (UTC) Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Thu Nov 17 10:12:31 2005 Return-path: Original-Received: from lists.gnu.org ([199.232.76.165]) by ciao.gmane.org with esmtp (Exim 4.43) id 1Ecfn6-0007AA-4V for ged-emacs-devel@m.gmane.org; Thu, 17 Nov 2005 10:10:48 +0100 Original-Received: from localhost ([127.0.0.1] helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1Ecfml-0003eE-Mv for ged-emacs-devel@m.gmane.org; Thu, 17 Nov 2005 04:10:27 -0500 Original-Received: from mailman by lists.gnu.org with tmda-scanned (Exim 4.43) id 1Ecetr-00009Z-RT for emacs-devel@gnu.org; Thu, 17 Nov 2005 03:13:44 -0500 Original-Received: from exim by lists.gnu.org with spam-scanned (Exim 4.43) id 1Eceto-000092-Tq for emacs-devel@gnu.org; Thu, 17 Nov 2005 03:13:41 -0500 Original-Received: from [199.232.76.173] (helo=monty-python.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1Ecetn-00007r-AK for emacs-devel@gnu.org; Thu, 17 Nov 2005 03:13:40 -0500 Original-Received: from [199.185.220.220] (helo=priv-edtnes56.telusplanet.net) by monty-python.gnu.org with esmtp (Exim 4.34) id 1Ecetn-0007Hb-42 for emacs-devel@gnu.org; Thu, 17 Nov 2005 03:13:39 -0500 Original-Received: from cut.bc.hsia.telus.net ([207.216.180.100]) by priv-edtnes56.telusplanet.net (InterMail vM.6.01.04.04 201-2131-118-104-20050224) with ESMTP id <20051117081337.UGOR27135.priv-edtnes56.telusplanet.net@cut.bc.hsia.telus.net> for ; Thu, 17 Nov 2005 01:13:37 -0700 Original-To: emacs-devel@gnu.org X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.5 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:46149 Archived-At: > Date: Mon, 14 Nov 2005 01:21:08 -0800 > From: Ryan Yeske > CC: eliz@gnu.org, dann@ics.uci.edu > So Eli, I suppose the thing to decide is whether or not to > install my patch that make the rcirc faces inherit the font-lock > ones or not. I'd prefer to leave rcirc faces independent at this point. Here is a new patch. Index: ChangeLog =================================================================== RCS file: /cvsroot/emacs/emacs/lisp/ChangeLog,v retrieving revision 1.8605 diff -u -r1.8605 ChangeLog --- ChangeLog 17 Nov 2005 05:32:33 -0000 1.8605 +++ ChangeLog 17 Nov 2005 08:09:42 -0000 @@ -1,3 +1,19 @@ +2005-11-16 Ryan Yeske + + * net/rcirc.el (rcirc-mangle-text): Add bold face property without + replacing existing properties. + (rcirc-my-nick, rcirc-other-nick, rcirc-server) + (rcirc-nick-in-message, rcirc-prompt): Use min-colors and remove + tty specs. + (rcirc-server-prefix): New face. + (rcirc-server): New face. + (rcirc-url-regexp): Generate with rx macro. + (rcirc-last-server-message-time): Add variable. + (rcirc-filter): Record time of last message. + (rcirc-keepalive): Kill processes that did not send a message + since the last ping. + (rcirc-mode): Give rcirc-topic a local binding here. + 2005-11-16 Luc Teirlinck * rfn-eshadow.el (file-name-shadow-properties) Index: net/rcirc.el =================================================================== RCS file: /cvsroot/emacs/emacs/lisp/net/rcirc.el,v retrieving revision 1.6 diff -u -r1.6 rcirc.el --- net/rcirc.el 4 Nov 2005 15:05:11 -0000 1.6 +++ net/rcirc.el 17 Nov 2005 08:09:43 -0000 @@ -257,7 +257,7 @@ (defvar rcirc-process-output nil) (defvar rcirc-topic nil) (defvar rcirc-keepalive-timer nil) -(make-variable-buffer-local 'rcirc-topic) +(defvar rcirc-last-server-message-time nil) (defun rcirc-connect (server port nick user-name full-name startup-channels) "Return a connection to SERVER on PORT. @@ -290,6 +290,8 @@ (setq rcirc-process-output nil) (make-local-variable 'rcirc-startup-channels) (setq rcirc-startup-channels startup-channels) + (make-local-variable 'rcirc-last-server-message-time) + (setq rcirc-last-server-message-time (current-time)) ;; identify (rcirc-send-string process (concat "NICK " nick)) @@ -313,11 +315,16 @@ ,@body)) (defun rcirc-keepalive () - "Send keep alive pings to active rcirc processes." + "Send keep alive pings to active rcirc processes. +Kill processes that have not received a server message since the +last ping." (if (rcirc-process-list) (mapc (lambda (process) (with-rcirc-process-buffer process - (rcirc-send-string process (concat "PING " rcirc-server)))) + (if (> (cadr (time-since rcirc-last-server-message-time)) + rcirc-keepalive-seconds) + (kill-process process) + (rcirc-send-string process (concat "PING " rcirc-server))))) (rcirc-process-list)) (cancel-timer rcirc-keepalive-timer) (setq rcirc-keepalive-timer nil))) @@ -380,6 +387,7 @@ "Called when PROCESS receives OUTPUT." (rcirc-debug process output) (with-rcirc-process-buffer process + (setq rcirc-last-server-message-time (current-time)) (setq rcirc-process-output (concat rcirc-process-output output)) (when (= (aref rcirc-process-output (1- (length rcirc-process-output))) ?\n) @@ -582,6 +590,8 @@ (setq rcirc-process process) (make-local-variable 'rcirc-target) (setq rcirc-target target) + (make-local-variable 'rcirc-topic) + (setq rcirc-topic nil) (make-local-variable 'rcirc-short-buffer-name) (setq rcirc-short-buffer-name nil) @@ -850,8 +860,8 @@ (process-buffer process)))) (defun rcirc-format-response-string (process sender response target text) - (concat (when rcirc-time-format - (format-time-string rcirc-time-format (current-time))) + (concat (rcirc-facify (format-time-string rcirc-time-format (current-time)) + 'rcirc-timestamp) (cond ((or (string= response "PRIVMSG") (string= response "NOTICE") (string= response "ACTION")) @@ -880,14 +890,15 @@ (t (rcirc-mangle-text process - (rcirc-facify - (concat "*** " - (when (not (string= sender (rcirc-server process))) - (concat (rcirc-user-nick sender) " ")) - (when (zerop (string-to-number response)) - (concat response " ")) - text) - 'rcirc-server)))))) + (concat (rcirc-facify "*** " 'rcirc-server-prefix) + (rcirc-facify + (concat + (when (not (string= sender (rcirc-server process))) + (concat (rcirc-user-nick sender) " ")) + (when (zerop (string-to-number response)) + (concat response " ")) + text) + 'rcirc-server))))))) (defvar rcirc-activity-type nil) (make-variable-buffer-local 'rcirc-activity-type) @@ -1446,11 +1457,16 @@ "Return a copy of STRING with FACE property added." (propertize (or string "") 'face face 'rear-nonsticky t)) -;; shy grouping must be used within this regexp (defvar rcirc-url-regexp - "\\b\\(?:\\(?:www\\.\\|\\(?:s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\ -\\|wais\\|mailto\\):\\)\\(?://[-a-zA-Z0-9_.]+:[0-9]*\\)?\\(?:[-a-zA-Z0-9_=!?#$\ -@~`%&*+|\\/:;.,]\\|\\w\\)+\\(?:[-a-zA-Z0-9_=#$@~`%&*+|\\/]\\|\\w\\)\\)" + (rx word-boundary + (or "www." + (and (or "http" "https" "ftp" "file" "gopher" "news" "telnet" "wais" + "mailto") + "://" + (1+ (char "a-zA-Z0-9_.")) + (optional ":" (1+ (char "0-9"))))) + (1+ (char "-a-zA-Z0-9_=!?#$\@~`%&*+|\\/:;.,")) + (char "-a-zA-Z0-9_=!?#$\@~`%&*+|\\/:;")) "Regexp matching URL's. Set to nil to disable URL features in rcirc.") (defun rcirc-browse-url (&optional arg) @@ -1498,14 +1514,21 @@ "Return TEXT with properties added based on various patterns." ;; ^B (setq text - (rcirc-map-regexp (lambda (start end string) - (add-text-properties - start end - (list 'face 'bold 'rear-nonsticky t) - string)) - ".*?" - text)) - (while (string-match "\\(.*\\)[]\\(.*\\)" text) ; deal with  + (rcirc-map-regexp + (lambda (start end string) + (let ((orig-face (get-text-property start 'face string))) + (add-text-properties + start end + (list 'face (if (listp orig-face) + (append orig-face + (list 'bold)) + (list orig-face 'bold)) + 'rear-nonsticky t) + string))) + ".*?" + text)) + ;; TODO: deal with ^_ and ^C colors sequences + (while (string-match "\\(.*\\)[]\\(.*\\)" text) (setq text (concat (match-string 1 text) (match-string 2 text)))) ;; my nick @@ -1527,7 +1550,10 @@ (lambda (start end string) (let ((orig-face (get-text-property start 'face string))) (add-text-properties start end - (list 'face (list orig-face 'bold) + (list 'face (if (listp orig-face) + (append orig-face + (list 'bold)) + (list orig-face 'bold)) 'rear-nonsticky t 'mouse-face 'highlight 'keymap rcirc-browse-url-map) @@ -1836,51 +1862,82 @@ :group 'rcirc :group 'faces) -(defface rcirc-my-nick - '((((type tty) (class color)) (:foreground "blue" :weight bold)) - (((class color) (background light)) (:foreground "Blue")) - (((class color) (background dark)) (:foreground "LightSkyBlue")) - (t (:inverse-video t :bold t))) +(defface rcirc-my-nick ; font-lock-function-name-face + '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) + (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) + (((class color) (min-colors 16) (background light)) (:foreground "Blue")) + (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) + (((class color) (min-colors 8)) (:foreground "blue" :weight bold)) + (t (:inverse-video t :weight bold))) "The face used to highlight my messages." :group 'rcirc-faces) -(defface rcirc-other-nick - '((((type tty) (class color)) (:foreground "yellow" :weight light)) - (((class grayscale) (background light)) - (:foreground "Gray90" :bold t :italic t)) +(defface rcirc-other-nick ; font-lock-variable-name-face + '((((class grayscale) (background light)) + (:foreground "Gray90" :weight bold :slant italic)) (((class grayscale) (background dark)) - (:foreground "DimGray" :bold t :italic t)) - (((class color) (background light)) (:foreground "DarkGoldenrod")) - (((class color) (background dark)) (:foreground "LightGoldenrod")) - (t (:bold t :italic t))) + (:foreground "DimGray" :weight bold :slant italic)) + (((class color) (min-colors 88) (background light)) (:foreground "DarkGoldenrod")) + (((class color) (min-colors 88) (background dark)) (:foreground "LightGoldenrod")) + (((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod")) + (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod")) + (((class color) (min-colors 8)) (:foreground "yellow" :weight light)) + (t (:weight bold :slant italic))) "The face used to highlight other messages." :group 'rcirc-faces) -(defface rcirc-server - '((((type tty pc) (class color) (background light)) (:foreground "red")) - (((type tty pc) (class color) (background dark)) (:foreground "red1")) - (((class grayscale) (background light)) - (:foreground "DimGray" :bold t :italic t)) +(defface rcirc-server ; font-lock-comment-face + '((((class grayscale) (background light)) + (:foreground "DimGray" :weight bold :slant italic)) (((class grayscale) (background dark)) - (:foreground "LightGray" :bold t :italic t)) - (((class color) (background light)) (:foreground "gray40")) - (((class color) (background dark)) (:foreground "chocolate1")) - (t (:bold t :italic t))) + (:foreground "LightGray" :weight bold :slant italic)) + (((class color) (min-colors 88) (background light)) + (:foreground "Firebrick")) + (((class color) (min-colors 88) (background dark)) + (:foreground "chocolate1")) + (((class color) (min-colors 16) (background light)) + (:foreground "red")) + (((class color) (min-colors 16) (background dark)) + (:foreground "red1")) + (((class color) (min-colors 8) (background light)) + ) + (((class color) (min-colors 8) (background dark)) + ) + (t (:weight bold :slant italic))) "The face used to highlight server messages." :group 'rcirc-faces) -(defface rcirc-nick-in-message - '((((type tty) (class color)) (:foreground "cyan" :weight bold)) - (((class grayscale) (background light)) (:foreground "LightGray" :bold t)) - (((class grayscale) (background dark)) (:foreground "DimGray" :bold t)) - (((class color) (background light)) (:foreground "Purple")) - (((class color) (background dark)) (:foreground "Cyan")) - (t (:bold t))) +(defface rcirc-server-prefix ; font-lock-comment-delimiter-face + '((default :inherit font-lock-comment-face) + (((class grayscale))) + (((class color) (min-colors 16))) + (((class color) (min-colors 8) (background light)) + :foreground "red") + (((class color) (min-colors 8) (background dark)) + :foreground "red1")) + "The face used to highlight server prefixes." + :group 'rcirc-faces) + +(defface rcirc-timestamp + '((t (:inherit default))) + "The face used to highlight timestamps." + :group 'rcirc-faces) + +(defface rcirc-nick-in-message ; font-lock-keyword-face + '((((class grayscale) (background light)) (:foreground "LightGray" :weight bold)) + (((class grayscale) (background dark)) (:foreground "DimGray" :weight bold)) + (((class color) (min-colors 88) (background light)) (:foreground "Purple")) + (((class color) (min-colors 88) (background dark)) (:foreground "Cyan1")) + (((class color) (min-colors 16) (background light)) (:foreground "Purple")) + (((class color) (min-colors 16) (background dark)) (:foreground "Cyan")) + (((class color) (min-colors 8)) (:foreground "cyan" :weight bold)) + (t (:weight bold))) "The face used to highlight instances of nick within messages." :group 'rcirc-faces) -(defface rcirc-prompt - '((((background dark)) (:foreground "cyan")) +(defface rcirc-prompt ; comint-highlight-prompt + '((((min-colors 88) (background dark)) (:foreground "cyan1")) + (((background dark)) (:foreground "cyan")) (t (:foreground "dark blue"))) "The face to use to highlight prompts." :group 'rcirc-faces)