(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.
(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
(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."
(inhibit-read-only t)
buffer-read-only)
(erase-buffer)
+ (riece-kill-all-overlays)
(while users
(insert (if (memq ?o (cdr (car users)))
"@"
(index 1)
(channels riece-current-channels))
(erase-buffer)
+ (riece-kill-all-overlays)
(while channels
(if (car channels)
(insert (riece-format-channel-list-line
(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)
(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)
(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)
(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
: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
(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)
(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)
(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))
(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
(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 "")
(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))
(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
projects / elisp / riece.git / commitdiff