X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Friece-display.el;h=964de45d9a49b04fcb49b7b5e18b61ecaaaf7d13;hb=c7360b5c6ab956fb5034d557a1c7474ff9a2c73f;hp=021ab0a985f43e1a09c85bbef0996700e78dc04a;hpb=57d046780969b7e65645f16ed42e178b43b8e206;p=riece diff --git a/lisp/riece-display.el b/lisp/riece-display.el index 021ab0a..964de45 100644 --- a/lisp/riece-display.el +++ b/lisp/riece-display.el @@ -28,13 +28,6 @@ (require 'riece-channel) (require 'riece-misc) -(defvar riece-update-buffer-functions - '(riece-user-list-update-buffer - riece-channel-list-update-buffer - riece-update-status-indicators - riece-update-channel-indicator - riece-update-channel-list-indicator)) - (defcustom riece-configure-windows-function #'riece-configure-windows "Function to configure windows." :type 'function @@ -46,13 +39,26 @@ :type 'function :group 'riece-looks) +(defvar riece-update-buffer-functions + '(riece-update-user-list-buffer + riece-update-channel-list-buffer + riece-update-status-indicators + riece-update-channel-indicator + riece-update-short-channel-indicator + riece-update-channel-list-indicator)) + +(defvar riece-redisplay-buffer nil + "Non-nil means the buffer needs to be updated. +Local to the buffers.") + (defun riece-configure-windows () (let ((buffer (window-buffer)) (show-user-list (and riece-user-list-buffer-mode riece-current-channel ;; User list buffer is nuisance for private conversation. - (riece-channel-p riece-current-channel)))) + (riece-channel-p (riece-identity-prefix + riece-current-channel))))) ;; Can't expand minibuffer to full frame. (if (eq (selected-window) (minibuffer-window)) (other-window 1)) @@ -95,67 +101,144 @@ (select-window (or (get-buffer-window buffer) (get-buffer-window riece-command-buffer))))) +(defun riece-configure-windows-top (&optional plist) + "Candidate of `riece-configure-windows-function'. +PLIST accept :command-height, :user-list-width, and :channel-list-width." + (let ((command-height (or (plist-get plist :command-height) 4)) + (user-list-width (or (plist-get plist :user-list-width) (+ 9 1 1))) + (channel-list-width (or (plist-get plist :channel-list-width) 18)) + (buffer (window-buffer)) + (show-user-list + (and riece-user-list-buffer-mode + riece-current-channel + ;; User list buffer is nuisance for private conversation. + (riece-channel-p (riece-identity-prefix + riece-current-channel))))) + ;; Can't expand minibuffer to full frame. + (when (eq (selected-window) (minibuffer-window)) + (other-window 1)) + (delete-other-windows) + ;; top of frame + (let ((rest-window (split-window (selected-window) command-height))) + (set-window-buffer (selected-window) + riece-command-buffer) + (select-window rest-window)) + ;; middle of frame (vertical-spilit when need) + (when (or (and riece-current-channel riece-channel-buffer-mode) + show-user-list) + (let ((rest-window + (split-window (selected-window) + (/ (* 5 (+ (window-height) command-height)) 8)))) + (cond + ;; channel-buffer + user-list + ((and show-user-list + (and riece-current-channel riece-channel-buffer-mode)) + (let ((user-list-window (split-window (selected-window) nil t))) + (set-window-buffer (selected-window) riece-channel-buffer) + (set-window-buffer user-list-window riece-user-list-buffer) + (select-window user-list-window) + (shrink-window-horizontally (- (window-width) user-list-width)) + (setq truncate-partial-width-windows nil))) + ;; only user-list + (show-user-list + (set-window-buffer (selected-window) riece-user-list-buffer)) + ;; only channel-buffer + (riece-channel-buffer-mode + (set-window-buffer (selected-window) riece-channel-buffer))) + (select-window rest-window))) + ;; bottom of frame + (if (and riece-current-channel + riece-channel-list-buffer-mode) + (let ((channel-list-window (split-window (selected-window) nil t))) + (set-window-buffer (selected-window) riece-others-buffer) + (set-window-buffer channel-list-window riece-channel-list-buffer) + (select-window channel-list-window) + (shrink-window-horizontally (- (window-width) channel-list-width)) + (setq truncate-partial-width-windows nil)) + (set-window-buffer (selected-window) riece-dialogue-buffer)) + (riece-set-window-points) + (select-window (or (get-buffer-window buffer) + (get-buffer-window riece-command-buffer))))) + (defun riece-set-window-points () - (if (and riece-user-list-buffer - (get-buffer-window riece-user-list-buffer)) + (if (get-buffer-window riece-user-list-buffer) (with-current-buffer riece-user-list-buffer (unless (riece-frozen riece-user-list-buffer) (set-window-start (get-buffer-window riece-user-list-buffer) (point-min))))) - (if (and riece-channel-list-buffer - (get-buffer-window riece-channel-list-buffer)) + (if (get-buffer-window riece-channel-list-buffer) (with-current-buffer riece-channel-list-buffer (unless (riece-frozen riece-channel-list-buffer) (set-window-start (get-buffer-window riece-channel-list-buffer) (point-min)))))) -(defun riece-user-list-update-buffer () - (if (and riece-user-list-buffer - (get-buffer riece-user-list-buffer)) - (save-excursion - (set-buffer riece-user-list-buffer) - (when (and riece-current-channel - (riece-channel-p riece-current-channel)) - (let ((inhibit-read-only t) - buffer-read-only - (users (riece-channel-get-users riece-current-channel)) - (operators (riece-channel-get-operators riece-current-channel)) - (speakers (riece-channel-get-speakers riece-current-channel))) - (erase-buffer) - (while users - (if (member (car users) operators) - (insert "@" (car users) "\n") - (if (member (car users) speakers) - (insert "+" (car users) "\n") - (insert " " (car users) "\n"))) - (setq users (cdr users)))))))) - -(defun riece-channel-list-update-buffer () - (if (and riece-channel-list-buffer - (get-buffer riece-channel-list-buffer)) - (save-excursion - (set-buffer riece-channel-list-buffer) +(defun riece-update-user-list-buffer () + (save-excursion + (set-buffer riece-user-list-buffer) + (when (and riece-redisplay-buffer + riece-current-channel + (riece-channel-p (riece-identity-prefix riece-current-channel))) + (let (users operators speakers) + (with-current-buffer (process-buffer (riece-server-process + (riece-identity-server + riece-current-channel))) + (setq users + (riece-channel-get-users + (riece-identity-prefix riece-current-channel)) + operators + (riece-channel-get-operators + (riece-identity-prefix riece-current-channel)) + speakers + (riece-channel-get-speakers + (riece-identity-prefix riece-current-channel)))) (let ((inhibit-read-only t) - buffer-read-only - (index 1) - (channels riece-current-channels)) + buffer-read-only) (erase-buffer) - (while channels - (if (car channels) - (insert (format "%2d: %s\n" index (car channels)))) - (setq index (1+ index) - channels (cdr channels))))))) + (while users + (if (member (car users) operators) + (insert "@" (car users) "\n") + (if (member (car users) speakers) + (insert "+" (car users) "\n") + (insert " " (car users) "\n"))) + (setq users (cdr users))))) + (setq riece-redisplay-buffer nil)))) + +(defun riece-update-channel-list-buffer () + (save-excursion + (set-buffer riece-channel-list-buffer) + (when riece-redisplay-buffer + (let ((inhibit-read-only t) + buffer-read-only + (index 1) + (channels riece-current-channels)) + (erase-buffer) + (while channels + (if (car channels) + (let ((point (point))) + (insert (format "%2d: %s\n" index + (riece-format-identity (car channels)))) + (put-text-property point (point) 'riece-identity + (car channels)))) + (setq index (1+ index) + channels (cdr channels)))) + (setq riece-redisplay-buffer nil)))) (defun riece-update-channel-indicator () (setq riece-channel-indicator (if riece-current-channel - (riece-concat-current-channel-modes - (if (and riece-current-channel - (riece-channel-p riece-current-channel) - (riece-channel-get-topic riece-current-channel)) - (concat riece-current-channel ": " - (riece-channel-get-topic riece-current-channel)) - riece-current-channel)) + (if (riece-channel-p (riece-identity-prefix riece-current-channel)) + (riece-concat-channel-modes + riece-current-channel + (riece-concat-channel-topic + riece-current-channel + (riece-format-identity riece-current-channel))) + (riece-format-identity riece-current-channel)) + "None"))) + +(defun riece-update-short-channel-indicator () + (setq riece-short-channel-indicator + (if riece-current-channel + (riece-format-identity riece-current-channel) "None"))) (defun riece-update-channel-list-indicator () @@ -170,26 +253,28 @@ (mapcar (lambda (channel) (prog1 (if channel - (format "%d:%s" index channel)) + (format "%d:%s" index + (riece-format-identity channel))) (setq index (1+ index)))) riece-current-channels)) ","))) (setq riece-channel-list-indicator "No channel"))) (defun riece-update-status-indicators () - (with-current-buffer riece-command-buffer - (riece-with-server-buffer - (setq riece-away-indicator - (if (and riece-real-nickname - (riece-user-get-away riece-real-nickname)) - "A" - "-") - riece-operator-indicator - (if (and riece-real-nickname - (riece-user-get-operator riece-real-nickname)) - "O" - "-") - riece-user-indicator riece-real-nickname))) + (if riece-current-channel + (with-current-buffer riece-command-buffer + (riece-with-server-buffer (riece-identity-server riece-current-channel) + (setq riece-away-indicator + (if (and riece-real-nickname + (riece-user-get-away riece-real-nickname)) + "A" + "-") + riece-operator-indicator + (if (and riece-real-nickname + (riece-user-get-operator riece-real-nickname)) + "O" + "-") + riece-user-indicator riece-real-nickname)))) (setq riece-freeze-indicator (with-current-buffer (if (and riece-channel-buffer-mode riece-channel-buffer) @@ -202,15 +287,20 @@ "-"))))) (defun riece-update-buffers () + (if riece-current-channel + (setq riece-channel-buffer (get-buffer (riece-channel-buffer-name + riece-current-channel)))) (run-hooks 'riece-update-buffer-functions) - (force-mode-line-update t) - (run-hooks 'riece-update-buffers-hook)) + (force-mode-line-update t)) + +(defun riece-channel-buffer-name (identity) + (format riece-channel-buffer-format (riece-format-identity identity))) (eval-when-compile (autoload 'riece-channel-mode "riece")) (defun riece-channel-buffer-create (identity) (with-current-buffer - (riece-get-buffer-create (format riece-channel-buffer-format identity)) + (riece-get-buffer-create (riece-channel-buffer-name identity)) (unless (eq major-mode 'riece-channel-mode) (riece-channel-mode) (let (buffer-read-only) @@ -218,49 +308,25 @@ (concat "Created on " (funcall riece-format-time-function (current-time)) - "\n")))) - (current-buffer))) - -(eval-when-compile - (autoload 'riece-user-list-mode "riece")) -(defun riece-user-list-buffer-create (identity) - (with-current-buffer - (riece-get-buffer-create (format riece-user-list-buffer-format identity)) - (unless (eq major-mode 'riece-user-list-mode) - (riece-user-list-mode)) + "\n")) + (run-hook-with-args 'riece-channel-buffer-create-functions identity))) (current-buffer))) (defun riece-switch-to-channel (identity) (setq riece-last-channel riece-current-channel - riece-current-channel identity - riece-channel-buffer - (cdr (riece-identity-assoc - identity riece-channel-buffer-alist)) - riece-user-list-buffer - (cdr (riece-identity-assoc - identity riece-user-list-buffer-alist))) + riece-current-channel identity) + (with-current-buffer riece-user-list-buffer + (setq riece-redisplay-buffer t)) (run-hooks 'riece-channel-switch-hook)) -(defun riece-join-channel (channel-name) - (let ((identity (riece-make-identity channel-name))) - (unless (riece-identity-member - identity riece-current-channels) - (setq riece-current-channels - (riece-identity-assign-binding - identity riece-current-channels - riece-default-channel-binding))) - (unless (riece-identity-assoc - identity riece-channel-buffer-alist) - (let ((buffer (riece-channel-buffer-create identity))) - (setq riece-channel-buffer-alist - (cons (cons identity buffer) - riece-channel-buffer-alist)))) - (unless (riece-identity-assoc - identity riece-user-list-buffer-alist) - (let ((buffer (riece-user-list-buffer-create identity))) - (setq riece-user-list-buffer-alist - (cons (cons identity buffer) - riece-user-list-buffer-alist)))))) +(defun riece-join-channel (identity) + (unless (riece-identity-member identity riece-current-channels) + (setq riece-current-channels + (riece-identity-assign-binding identity riece-current-channels + riece-default-channel-binding)) + (riece-channel-buffer-create identity) + (with-current-buffer riece-channel-list-buffer + (setq riece-redisplay-buffer t)))) (defun riece-switch-to-nearest-channel (pointer) (let ((start riece-current-channels) @@ -279,14 +345,14 @@ (setq riece-last-channel riece-current-channel riece-current-channel nil)))) -(defun riece-part-channel (channel-name) - (let* ((identity (riece-make-identity channel-name)) - (pointer (riece-identity-member - identity riece-current-channels))) +(defun riece-part-channel (identity) + (let ((pointer (riece-identity-member identity riece-current-channels))) (if pointer (setcar pointer nil)) (if (riece-identity-equal identity riece-current-channel) - (riece-switch-to-nearest-channel pointer)))) + (riece-switch-to-nearest-channel pointer)) + (with-current-buffer riece-channel-list-buffer + (setq riece-redisplay-buffer t)))) (defun riece-configure-windows-predicate () ;; The current channel is changed, and some buffers are visible.