From cc93ede6798603a9dd66468a5522c47f0ba809ad Mon Sep 17 00:00:00 2001 From: Daiki 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 -- 2.34.1