* riece-layout.el: No longer provided as an add-on.
[riece] / lisp / riece-display.el
index ee9c090..9a2400e 100644 (file)
 (require 'riece-options)
 (require 'riece-channel)
 (require 'riece-misc)
+(require 'riece-layout)
 
 (defvar riece-update-buffer-functions
-  '(riece-user-list-update-buffer
-    riece-channel-list-update-buffer
+  '(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))
 
-(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)
+(defvar riece-redisplay-buffer nil
+  "Non-nil means the buffer needs to be updated.
+Local to the buffers.")
+
+(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))
-         "None"))
-  (with-current-buffer riece-command-buffer
-    (force-mode-line-update)))
+           (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 ()
   (if (and riece-current-channels
                     (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 ()
-  (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)
              "-")))))
 
 (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)
                           (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)))
+       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-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))))))
+(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)
       (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-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)
-       (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))))))))
+    (if (riece-identity-equal identity riece-current-channel)
+       (riece-switch-to-nearest-channel pointer))
+    (with-current-buffer riece-channel-list-buffer
+      (setq riece-redisplay-buffer t))))
 
 (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)