X-Git-Url: https://cgit.sxemacs.org/?p=riece;a=blobdiff_plain;f=lisp%2Friece-misc.el;h=eb0de2079ee87cf85d843ae440cd7ffd469253c1;hp=c4fa7bc8c8a6e0af4074dcc4eaa409a0934bba45;hb=a0b576c2225bad55b58b7646314c0194172a4742;hpb=9174f38ace6e8cd879b41adc4d6aa4b5b727f7ea diff --git a/lisp/riece-misc.el b/lisp/riece-misc.el index c4fa7bc..eb0de20 100644 --- a/lisp/riece-misc.el +++ b/lisp/riece-misc.el @@ -31,6 +31,7 @@ (require 'riece-channel) (require 'riece-server) (require 'riece-user) +(require 'riece-mode) (defun riece-get-buffer-create (name &optional init-major-mode) (let ((buffer (get-buffer name))) @@ -68,12 +69,20 @@ (set-buffer (car buffers)) (let ((inhibit-read-only t) buffer-read-only - (start (goto-char (point-max)))) + (start (goto-char (point-max))) + window + point) (insert (format-time-string "%H:%M") " " string) + (setq point (point)) (if (and (not (riece-frozen (current-buffer))) - (get-buffer-window (current-buffer))) - (set-window-point (get-buffer-window (current-buffer)) - (point))) + (setq window (get-buffer-window (current-buffer))) + (not (pos-visible-in-window-p point window))) + (save-excursion ;save-selected-window changes + ;current buffer + (save-selected-window + (select-window window) + (goto-char point) ;select-window changes current point + (recenter riece-window-center-line)))) (run-hook-with-args 'riece-after-insert-functions start (point)))) (setq buffers (cdr buffers)))) @@ -105,9 +114,14 @@ \(i.e. it matches `riece-channel-regexp')" (string-match (concat "^" riece-channel-regexp) string)) +(defun riece-user-p (string) + "Return t if STRING is a user. +\(i.e. it matches `riece-user-regexp')" + (string-match (concat "^" riece-user-regexp) string)) + (defun riece-current-nickname () "Return the current nickname." - (riece-with-server-buffer (riece-identity-server riece-current-channel) + (riece-with-server-buffer (riece-current-server-name) (if riece-real-nickname (riece-make-identity riece-real-nickname riece-server-name)))) @@ -119,11 +133,12 @@ (while (string-match "^\\([^ ]+\\) +" string) (setq parameters (nconc parameters (list (match-string 1 string))) string (substring string (match-end 0))) - (and (not (equal "" string)) (eq ?: (aref string 0)) - (setq string (substring string 1)) - (throw 'done nil)))) - (or (equal "" string) - (setq parameters (nconc parameters (list string)))) + (when (and (not (equal "" string)) (eq ?: (aref string 0))) + (setq string (substring string 1) + parameters (nconc parameters (list string))) + (throw 'done nil))) + (or (equal "" string) + (setq parameters (nconc parameters (list string))))) parameters))) (defun riece-concat-channel-topic (target string) @@ -138,7 +153,16 @@ (riece-with-server-buffer (riece-identity-server target) (let ((modes (riece-channel-get-modes (riece-identity-prefix target)))) (if modes - (concat string " [" (apply #'string modes) "]") + (concat string " [" + (mapconcat + (lambda (mode) + (if (riece-mode-parameter mode) + (format "%c(%s)" + (riece-mode-flag mode) + (riece-mode-parameter mode)) + (char-to-string (riece-mode-flag mode)))) + modes "") + "]") string)))) (defun riece-concat-message (string message) @@ -150,7 +174,16 @@ (defun riece-concat-server-name (string) (if (equal riece-server-name "") string - (concat string " (from " riece-server-name ")"))) + (let ((server-name (concat " (from " riece-server-name ")"))) + (put-text-property 0 (length server-name) + 'riece-server-name riece-server-name + server-name) + (concat string server-name)))) + +(defun riece-concat-user-status (status string) + (if status + (concat string " [" (mapconcat #'identity status ", ") "]") + string)) (defun riece-prefix-user-at-host (prefix) (if (string-match "!" prefix) @@ -180,17 +213,40 @@ (substring user-at-host 1) user-at-host)) -(defun riece-get-users-on-server () - (riece-with-server-buffer (riece-identity-server riece-current-channel) - (let (users) +(defun riece-get-users-on-server (server-name) + (riece-with-server-buffer server-name + (let (identities) + (mapatoms + (lambda (user) + (setq identities + (cons (riece-make-identity (symbol-name user) server-name) + identities))) + riece-user-obarray) + identities))) + +(defun riece-get-channels-on-server (server-name) + (riece-with-server-buffer server-name + (let (identities) (mapatoms - (lambda (atom) - (unless (riece-channel-p (symbol-name atom)) - (setq users (cons (symbol-name atom) users)))) - riece-obarray) - (if (member riece-real-nickname users) - users - (cons riece-real-nickname users))))) + (lambda (channel) + (setq identities + (cons (riece-make-identity (symbol-name channel) server-name) + identities))) + riece-channel-obarray) + identities))) + +(defun riece-get-identities-on-server (server-name) + (nconc (riece-get-channels-on-server server-name) + (riece-get-users-on-server server-name))) + +(defun riece-check-channel-commands-are-usable (&optional channel) + (unless riece-current-channel + (error (substitute-command-keys + "Type \\[riece-command-join] to join a channel"))) + (if (and channel + (not (riece-channel-p (riece-identity-prefix + riece-current-channel)))) + (error "Not on a channel"))) (provide 'riece-misc)