From 67da3eae471ebe17637a21f8fa7daab738fee898 Mon Sep 17 00:00:00 2001
From: ueno <ueno>
Date: Fri, 24 Oct 2003 02:17:04 +0000
Subject: [PATCH] * riece.el: Add autoload setting for derived-mode-class.
 (riece-shrink-buffer-idle-timer): New variable. (riece):
 Set idle timer to shrink channel buffers.
 (riece-shrink-buffer): New function.

* riece-xemacs.el (riece-overlays-in): New function.
(riece-delete-overlay): New alias.
(riece-kill-all-overlays): New function.

* riece-server.el (riece-quit-server-process): Don't set timer if
riece-quit-timeout is nil.

* riece-options.el (riece-quit-timeout): Change custom type.
(riece-shrink-buffer-idle-time-delay): New user option.
(riece-max-buffer-size): New user option.

* riece-icon.el (riece-icon-add-image-region) [XEmacs]: Delete
extents if already exists.

* riece-emacs.el (riece-overlays-in): New alias.
(riece-delete-overlay): New alias.
(riece-kill-all-overlays): New function.
(riece-run-with-idle-timer): New alias.
(riece-cancel-timer): New alias.

* riece-display.el (riece-update-user-list-buffer): Kill all
overlays in buffer.
(riece-update-channel-list-buffer): Ditto.

* riece-commands.el (riece-command-set-operators): Reset group.
(riece-command-set-speakers): Ditto.
---
 lisp/riece-commands.el |   42 ++++++++++++++++++++++--------------------
 lisp/riece-display.el  |    2 ++
 lisp/riece-emacs.el    |   13 +++++++++++++
 lisp/riece-icon.el     |    8 +++++++-
 lisp/riece-options.el  |   14 +++++++++++++-
 lisp/riece-server.el   |   17 +++++++++--------
 lisp/riece-xemacs.el   |   42 +++++++++++++++++++++++++++++++++++++-----
 lisp/riece.el          |   35 +++++++++++++++++++++++++++++++++++
 8 files changed, 138 insertions(+), 35 deletions(-)

diff --git a/lisp/riece-commands.el b/lisp/riece-commands.el
index 039543d..6bc20a9 100644
--- a/lisp/riece-commands.el
+++ b/lisp/riece-commands.el
@@ -294,16 +294,17 @@ the layout to the selected layout-name."
     (while users
       (setq group (cons (car users) group)
 	    users (cdr users))
-      (if (or (= (length group) 3)
-	      (null users))
-	  (riece-send-string
-	   (format "MODE %s %c%s %s\r\n"
-		   (riece-identity-prefix riece-current-channel)
-		   (if current-prefix-arg
-		       ?-
-		     ?+)
-		   (make-string (length group) ?o)
-		   (mapconcat #'identity group " ")))))))
+      (when (or (= (length group) 3)
+		(null users))
+	(riece-send-string
+	 (format "MODE %s %c%s %s\r\n"
+		 (riece-identity-prefix riece-current-channel)
+		 (if current-prefix-arg
+		     ?-
+		   ?+)
+		 (make-string (length group) ?o)
+		 (mapconcat #'identity group " ")))
+	(setq group nil)))))
 
 (defun riece-command-set-speakers (users &optional arg)
   (interactive
@@ -326,16 +327,17 @@ the layout to the selected layout-name."
     (while users
       (setq group (cons (car users) group)
 	    users (cdr users))
-      (if (or (= (length group) 3)
-	      (null users))
-	  (riece-send-string
-	   (format "MODE %s %c%s %s\r\n"
-		   (riece-identity-prefix riece-current-channel)
-		   (if current-prefix-arg
-		       ?-
-		     ?+)
-		   (make-string (length group) ?v)
-		   (mapconcat #'identity group " ")))))))
+      (when (or (= (length group) 3)
+		(null users))
+	(riece-send-string
+	 (format "MODE %s %c%s %s\r\n"
+		 (riece-identity-prefix riece-current-channel)
+		 (if current-prefix-arg
+		     ?-
+		   ?+)
+		 (make-string (length group) ?v)
+		 (mapconcat #'identity group " ")))
+	(setq group nil)))))
 
 (defun riece-command-send-message (message notice)
   "Send MESSAGE to the current channel."
diff --git a/lisp/riece-display.el b/lisp/riece-display.el
index dcb834e..f675e99 100644
--- a/lisp/riece-display.el
+++ b/lisp/riece-display.el
@@ -59,6 +59,7 @@ Local to the buffer in `riece-buffer-list'.")
 	       (inhibit-read-only t)
 	       buffer-read-only)
 	  (erase-buffer)
+	  (riece-kill-all-overlays)
 	  (while users
 	    (insert (if (memq ?o (cdr (car users)))
 			"@"
@@ -81,6 +82,7 @@ Local to the buffer in `riece-buffer-list'.")
 	  (index 1)
 	  (channels riece-current-channels))
       (erase-buffer)
+      (riece-kill-all-overlays)
       (while channels
 	(if (car channels)
 	    (insert (riece-format-channel-list-line
diff --git a/lisp/riece-emacs.el b/lisp/riece-emacs.el
index a22ecac..00759b7 100644
--- a/lisp/riece-emacs.el
+++ b/lisp/riece-emacs.el
@@ -76,8 +76,21 @@
 (defalias 'riece-overlay-put 'overlay-put)
 (defalias 'riece-overlay-start 'overlay-start)
 (defalias 'riece-overlay-buffer 'overlay-buffer)
+(defalias 'riece-overlays-in 'overlays-in)
+(defalias 'riece-delete-overlay 'delete-overlay)
+
+(defun riece-kill-all-overlays ()
+  "Delete all overlays in the current buffer."
+  (let* ((overlay-lists (overlay-lists))
+         (buffer-read-only nil)
+         (overlays (delq nil (nconc (car overlay-lists) (cdr overlay-lists)))))
+    (while overlays
+      (delete-overlay (car overlays))
+      (setq overlays (cdr overlays)))))
 
 (defalias 'riece-run-at-time 'run-at-time)
+(defalias 'riece-run-with-idle-timer 'run-with-idle-timer)
+(defalias 'riece-cancel-timer 'cancel-timer)
 
 (provide 'riece-emacs)
 
diff --git a/lisp/riece-icon.el b/lisp/riece-icon.el
index 0e067f9..65a3de4 100644
--- a/lisp/riece-icon.el
+++ b/lisp/riece-icon.el
@@ -203,6 +203,12 @@ static char * a_xpm[] = {
 (eval-and-compile
   (if (featurep 'xemacs)
       (defun riece-icon-add-image-region (image start end)
+	(map-extents
+	 (lambda (extent ignore)
+	   (if (or (extent-property extent 'riece-icon-user-list-extent)
+		   (extent-property extent 'riece-icon-user-list-annotation))
+	       (delete-extent extent)))
+	 (current-buffer) start end)
 	(let ((extent (make-extent start end))
 	      (annotation (make-annotation image end 'text)))
 	  (set-extent-property extent 'end-open t)
@@ -212,7 +218,7 @@ static char * a_xpm[] = {
 	  (set-extent-property annotation
 			       'riece-icon-user-list-extent extent)
 	  (set-extent-property extent
-			       'riece-icon-user-list-extent annotation)))
+			       'riece-icon-user-list-annotation annotation)))
     (defun riece-icon-add-image-region (image start end)
       (let ((inhibit-read-only t)
 	    buffer-read-only)
diff --git a/lisp/riece-options.el b/lisp/riece-options.el
index d194b85..f4dbbed 100644
--- a/lisp/riece-options.el
+++ b/lisp/riece-options.el
@@ -199,7 +199,8 @@ way is to put Riece variables on .emacs or file loaded from there."
 
 (defcustom riece-quit-timeout 10
   "Quit timeout when there is no response from server."
-  :type 'integer
+  :type '(radio (integer :tag "Seconds")
+		(const nil))
   :group 'riece-server)
 
 (defcustom riece-channel-buffer-mode t
@@ -253,6 +254,17 @@ way is to put Riece variables on .emacs or file loaded from there."
   :type 'function
   :group 'riece-options)
 
+(defcustom riece-shrink-buffer-idle-time-delay 5
+  "Number of idle seconds to wait before shrinking channel buffers."
+  :type 'integer
+  :group 'riece-options)
+
+(defcustom riece-max-buffer-size 65535
+  "Maximum size of channel buffers."
+  :type '(radio (integer :tag "Number of characters")
+		(const nil))
+  :group 'riece-options)
+
 (defcustom riece-format-time-function #'current-time-string
   "Function to convert the specified time to the human readable form."
   :type 'function
diff --git a/lisp/riece-server.el b/lisp/riece-server.el
index 62e26bb..4164488 100644
--- a/lisp/riece-server.el
+++ b/lisp/riece-server.el
@@ -225,14 +225,15 @@ the `riece-server-keyword-map' variable."
 (eval-when-compile
   (autoload 'riece-exit "riece"))
 (defun riece-quit-server-process (process &optional message)
-  (riece-run-at-time riece-quit-timeout nil
-		     (lambda (process)
-		       (when (rassq process riece-server-process-alist)
-			 (riece-close-server-process process)
-			 ;; If no server process is available, exit.
-			 (unless riece-server-process-alist
-			   (riece-exit))))
-		     process)
+  (if riece-quit-timeout
+      (riece-run-at-time riece-quit-timeout nil
+			 (lambda (process)
+			   (when (rassq process riece-server-process-alist)
+			     (riece-close-server-process process)
+			     ;; If no server process is available, exit.
+			     (unless riece-server-process-alist
+			       (riece-exit))))
+			 process))
   (riece-process-send-string process
 			     (if message
 				 (format "QUIT :%s\r\n" message)
diff --git a/lisp/riece-xemacs.el b/lisp/riece-xemacs.el
index dd896dd..6327de6 100644
--- a/lisp/riece-xemacs.el
+++ b/lisp/riece-xemacs.el
@@ -77,13 +77,45 @@
 (defalias 'riece-overlay-start 'extent-start-position)
 (defalias 'riece-overlay-buffer 'extent-buffer)
 
+(defun riece-overlays-in (start end)
+  (extent-list (current-buffer) start end))
+
+(defalias 'riece-delete-overlay 'delete-extent)
+
+(defun riece-kill-all-overlays ()
+  "Delete all extents in the current buffer."
+  (map-extents (lambda (extent ignore)
+                 (delete-extent extent)
+                 nil)))
+
 ;;; stolen (and renamed) from nnheaderxm.el.
+(defun riece-xemacs-generate-timer-name (&optional prefix)
+  (let ((counter '(0)))
+    (format "%s-%d"
+	    (or prefix
+		"riece-xemacs-timer")
+	    (prog1 (car counter)
+	      (setcar counter (1+ (car counter)))))))
+
 (defun riece-run-at-time (time repeat function &rest args)
-  (start-itimer
-   "riece-run-at-time"
-   `(lambda ()
-      (,function ,@args))
-   time repeat))
+  (let ((name (riece-xemacs-generate-timer-name "riece-run-at-time")))
+    (start-itimer
+     name
+     `(lambda ()
+	(,function ,@args))
+     time repeat)
+    name))
+
+(defun riece-run-with-idle-timer (time repeat function &rest args)
+  (let ((name (riece-xemacs-generate-timer-name "riece-run-with-idle-timer")))
+    (start-itimer
+     name
+     `(lambda ()
+	(,function ,@args))
+     time repeat t)
+    name))
+
+(defalias 'riece-cancel-timer 'delete-itimer)
 
 (provide 'riece-xemacs)
 
diff --git a/lisp/riece.el b/lisp/riece.el
index ca0c1b9..8cdb159 100644
--- a/lisp/riece.el
+++ b/lisp/riece.el
@@ -30,6 +30,8 @@
 (require 'riece-compat)
 (require 'riece-commands)
 
+(autoload 'derived-mode-class "derived")
+
 (defvar riece-channel-list-mode-map (make-sparse-keymap))
 (defvar riece-user-list-mode-map (make-sparse-keymap))
 
@@ -57,6 +59,9 @@
     (riece-channel-list-buffer "*Channels*" riece-channel-list-mode)
     (riece-user-list-buffer " *Users*" riece-user-list-mode)))
 
+(defvar riece-shrink-buffer-idle-timer nil
+  "Timer object to periodically shrink channel buffers.")
+
 (defvar riece-select-keys
   `("1" riece-command-switch-to-channel-by-number-1
     "2" riece-command-switch-to-channel-by-number-2
@@ -265,6 +270,19 @@ If optional argument CONFIRM is non-nil, ask which IRC server to connect."
     (if (stringp riece-server)
 	(setq riece-server (riece-server-name-to-server riece-server)))
     (riece-create-buffers)
+    (if riece-max-buffer-size
+	(setq riece-shrink-buffer-idle-timer
+	      (riece-run-with-idle-timer
+	       riece-shrink-buffer-idle-time-delay nil
+	       (lambda ()
+		 (let ((buffers riece-buffer-list))
+		   (while buffers
+		     (if (eq (derived-mode-class
+			      (with-current-buffer (car buffers)
+				major-mode))
+			     'riece-dialogue-mode)
+			 (riece-shrink-buffer (car buffers)))
+		     (setq buffers (cdr buffers))))))))
     (switch-to-buffer riece-command-buffer)
     (riece-redisplay-buffers)
     (riece-open-server riece-server "")
@@ -272,6 +290,21 @@ If optional argument CONFIRM is non-nil, ask which IRC server to connect."
     (message "%s" (substitute-command-keys
 		   "Type \\[describe-mode] for help"))))
 
+(defun riece-shrink-buffer (buffer)
+  (save-excursion
+    (set-buffer buffer)
+    (goto-char (point-min))
+    (while (> (buffer-size) riece-max-buffer-size)
+      (let* ((inhibit-read-only t)
+	     buffer-read-only
+	     (start (point))
+	     (end (progn (beginning-of-line 2) (point)))
+	     (overlays (riece-overlays-in start end)))
+	(while overlays
+	  (riece-delete-overlay (car overlays))
+	  (setq overlays (cdr overlays)))
+	(delete-region start end)))))
+
 (defun riece-exit ()
   (if riece-save-variables-are-dirty
       (riece-save-variables-files))
@@ -280,6 +313,8 @@ If optional argument CONFIRM is non-nil, ask which IRC server to connect."
 	     (buffer-live-p (car riece-buffer-list)))
 	(funcall riece-buffer-dispose-function (car riece-buffer-list)))
     (setq riece-buffer-list (cdr riece-buffer-list)))
+  (if riece-shrink-buffer-idle-timer
+      (riece-cancel-timer riece-shrink-buffer-idle-timer))
   (setq riece-server nil
 	riece-current-channels nil
 	riece-current-channel nil
-- 
1.7.10.4