X-Git-Url: https://cgit.sxemacs.org/?p=riece;a=blobdiff_plain;f=lisp%2Friece-display.el;h=b3c2e6e52396103c6eb61f4a754c814a0a2bebfc;hp=ee9c09045198175bde55208ff7991a35f83b0faa;hb=b5365aa756134edbc27c4fd1321716a8311a6fa3;hpb=30d51f630920fb7e215af86f2ab8e9fa3c534289

diff --git a/lisp/riece-display.el b/lisp/riece-display.el
index ee9c090..b3c2e6e 100644
--- a/lisp/riece-display.el
+++ b/lisp/riece-display.el
@@ -27,138 +27,97 @@
 (require 'riece-options)
 (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
+(require 'riece-layout)
+
+(defvar riece-update-buffer-functions nil
+  "Functions to redisplay the buffer.
+Local to the buffer in `riece-buffer-list'.")
+  
+(defvar riece-update-indicator-functions
+  '(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
-  :group 'riece-looks)
-
-(defcustom riece-configure-windows-predicate
-  #'riece-configure-windows-predicate
-  "Function to check whether window reconfiguration is needed."
-  :type 'function
-  :group 'riece-looks)
-
-(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))))
-    ;; Can't expand minibuffer to full frame.
-    (if (eq (selected-window) (minibuffer-window))
-	(other-window 1))
-    (delete-other-windows)
-    (if (and riece-current-channel
-	     (or show-user-list riece-channel-list-buffer-mode))
-	(let ((rest-window (split-window (selected-window)
-					 (/ (window-width) 5) t)))
-	  (if (and show-user-list riece-channel-list-buffer-mode)
-	      (progn
-		(set-window-buffer (split-window)
-				   riece-channel-list-buffer)
-		(set-window-buffer (selected-window)
-				   riece-user-list-buffer))
-	    (if show-user-list
-		(set-window-buffer (selected-window)
-				   riece-user-list-buffer)
-	      (if riece-channel-list-buffer-mode
-		  (set-window-buffer (selected-window)
-				     riece-channel-list-buffer))))
-	  (select-window rest-window)))
-    (if (and riece-current-channel
-	     riece-channel-buffer-mode)
-	(let ((rest-window (split-window)))
-	  (set-window-buffer (selected-window)
-			     riece-channel-buffer)
-	  (set-window-buffer (split-window rest-window 4)
-			     riece-others-buffer)
-	  (with-current-buffer riece-channel-buffer
-	    (setq truncate-partial-width-windows nil))
-	  (with-current-buffer riece-others-buffer
-	    (setq truncate-partial-width-windows nil))
-	  (set-window-buffer rest-window
-			     riece-command-buffer))
-      (set-window-buffer (split-window (selected-window) 4)
-			 riece-dialogue-buffer)
-      (set-window-buffer (selected-window)
-			 riece-command-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))
-      (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))
-      (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)
+    riece-update-long-channel-indicator
+    riece-update-channel-list-indicator)
+  "Functions to update modeline indicators.")
+
+(defun riece-update-user-list-buffer ()
+  (save-excursion
+    (set-buffer riece-user-list-buffer)
+    (when (and 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
+	    (insert (if (member (car users) operators)
+			"@"
+		      (if (member (car users) speakers)
+			  "+"
+			" "))
+		    (riece-format-identity
+		     (riece-make-identity (car users)
+					  (riece-identity-server
+					   riece-current-channel))
+		     t)
+		    "\n")
+	    (setq users (cdr users))))))))
+
+(defun riece-update-channel-list-buffer ()
+  (save-excursion
+    (set-buffer riece-channel-list-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 (riece-format-channel-list-line
+		       index (car channels)))))
+	(setq index (1+ index)
+	      channels (cdr channels))))))
+
+(defun riece-format-channel-list-line (index channel)
+  (or (run-hook-with-args-until-success
+       'riece-format-channel-list-line-functions index channel)
+      (concat (format "%2d:%c" index
+		      (if (riece-identity-equal channel riece-current-channel)
+			  ?*
+			? ))
+	      (riece-format-identity channel)
+	      "\n")))
 
 (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))
-	  "None"))
-  (with-current-buffer riece-command-buffer
-    (force-mode-line-update)))
+	    (riece-format-identity riece-current-channel)
+	  "None")))
+
+(defun riece-update-long-channel-indicator ()
+  (setq riece-long-channel-indicator
+	(if 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-channel-list-indicator ()
   (if (and riece-current-channels
@@ -171,25 +130,30 @@
 	       (delq nil
 		     (mapcar
 		      (lambda (channel)
-			(prog1 (if channel
-				   (format "%d:%s" index channel))
+			(prog1
+			    (if 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 ()
-  (riece-with-server-buffer
-   (setq riece-away-indicator
-	 (if (and riece-real-nickname
-		  (riece-user-get-away riece-real-nickname))
-	     "A"
-	   "-"))
-   (setq riece-operator-indicator
-	 (if (and riece-real-nickname
-		  (riece-user-get-operator riece-real-nickname))
-	     "O"
-	   "-")))
+  (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)
@@ -201,16 +165,30 @@
 		"F"
 	      "-")))))
 
-(defun riece-update-buffers ()
-  (run-hooks 'riece-update-buffer-functions)
-  (force-mode-line-update t)
-  (run-hooks 'riece-update-buffers-hook))
+(defun riece-update-buffers (&optional buffers)
+  (unless buffers
+    (setq buffers riece-buffer-list))
+  (while buffers
+    (save-excursion
+      (set-buffer (car buffers))
+      (run-hooks 'riece-update-buffer-functions))
+    (setq buffers (cdr buffers)))
+  (run-hooks 'riece-update-indicator-functions)
+  (force-mode-line-update t))
+
+(defun riece-channel-buffer-name (identity)
+  (let ((channels (riece-identity-member identity riece-current-channels)))
+    (if channels
+	(setq identity (car channels))
+      (if riece-debug
+	  (message "%S is not a member of riece-current-channels" 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 +196,28 @@
 			   (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-no-server
-	      identity riece-channel-buffer-alist))
-	riece-user-list-buffer 
-	(cdr (riece-identity-assoc-no-server
-	      identity riece-user-list-buffer-alist)))
-  (run-hooks 'riece-channel-switch-hook))
-
-(defun riece-join-channel (channel-name)
-  (let ((identity (riece-make-identity channel-name)))
-    (unless (riece-identity-member-no-server
-	     identity riece-current-channels)
-      (setq riece-current-channels
-	    (riece-identity-assign-binding
-	     identity riece-current-channels
-	     riece-default-channel-binding)))
-    (unless (riece-identity-assoc-no-server
-	     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-no-server
-	     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))))))
+  (let ((last riece-current-channel))
+    (setq riece-current-channel identity
+	  riece-channel-buffer (get-buffer (riece-channel-buffer-name
+					    riece-current-channel)))
+    (run-hook-with-args 'riece-after-switch-to-channel-functions last)))
+
+(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
+	   (mapcar
+	    (lambda (channel)
+	      (if channel
+		  (riece-parse-identity channel)))
+	    riece-default-channel-binding)))
+    (riece-channel-buffer-create identity)))
 
 (defun riece-switch-to-nearest-channel (pointer)
   (let ((start riece-current-channels)
@@ -276,35 +233,20 @@
       (setq identity (car pointer)))
     (if identity
 	(riece-switch-to-channel identity)
-      (setq riece-last-channel riece-current-channel
-	    riece-current-channel nil))))
+      (let ((last riece-current-channel))
+	(run-hook-with-args 'riece-after-switch-to-channel-functions last)
+	(setq riece-current-channel nil)))))
 
-(defun riece-part-channel (channel-name)
-  (let* ((identity (riece-make-identity channel-name))
-	 (pointer (riece-identity-member-no-server
-		   identity riece-current-channels)))
+(defun riece-part-channel (identity)
+  (let ((pointer (riece-identity-member identity riece-current-channels)))
     (if pointer
 	(setcar pointer nil))
-    ;;XXX
-    (if (riece-identity-equal-no-server identity riece-current-channel)
+    (if (riece-identity-equal identity riece-current-channel)
 	(riece-switch-to-nearest-channel pointer))))
 
-(defun riece-configure-windows-predicate ()
-  ;; The current channel is changed, and some buffers are visible.
-  (unless (equal riece-last-channel riece-current-channel)
-    (let ((buffers riece-buffer-list))
-      (catch 'found
-	(while buffers
-	  (if (and (buffer-live-p (car buffers))
-		   (get-buffer-window (car buffers)))
-	      (throw 'found t)
-	    (setq buffers (cdr buffers))))))))
-
 (defun riece-redisplay-buffers (&optional force)
   (riece-update-buffers)
-  (if (or force
-	  (funcall riece-configure-windows-predicate))
-      (funcall riece-configure-windows-function))
+  (riece-redraw-layout force)
   (run-hooks 'riece-redisplay-buffers-hook))
 
 (provide 'riece-display)