X-Git-Url: https://cgit.sxemacs.org/?p=riece;a=blobdiff_plain;f=lisp%2Friece-misc.el;h=eb0de2079ee87cf85d843ae440cd7ffd469253c1;hp=2ba578582ebb5c524ee57acebd84062785f8e4f4;hb=a0b576c2225bad55b58b7646314c0194172a4742;hpb=005a2a7642c9f43d699922799801124a77d56f5d diff --git a/lisp/riece-misc.el b/lisp/riece-misc.el index 2ba5785..eb0de20 100644 --- a/lisp/riece-misc.el +++ b/lisp/riece-misc.el @@ -31,28 +31,58 @@ (require 'riece-channel) (require 'riece-server) (require 'riece-user) - -(defun riece-get-buffer-create (name) - (let ((buffer (get-buffer-create name))) +(require 'riece-mode) + +(defun riece-get-buffer-create (name &optional init-major-mode) + (let ((buffer (get-buffer name))) + (unless (and buffer + (or (null init-major-mode) + (eq (with-current-buffer buffer + major-mode) + init-major-mode))) + (setq buffer (generate-new-buffer name))) (unless (memq buffer riece-buffer-list) (setq riece-buffer-list (cons buffer riece-buffer-list))) buffer)) +(defun riece-scan-property-region (property start end function) + (catch 'done + (while t + ;; Search for the beginning of the property region. + (unless (get-text-property start property) + (setq start (next-single-property-change start property nil end))) + (if (= start end) + (throw 'done nil)) + ;; Search for the end of the property region. + (let ((region-end (next-single-property-change start property nil end))) + (if (= region-end end) + (throw 'done nil)) + (funcall function start region-end) + (setq start region-end))))) + (defun riece-insert (buffers string) (unless (listp buffers) (setq buffers (list buffers))) (while buffers (run-hooks 'riece-before-insert-functions) (save-excursion - (set-buffer (riece-get-buffer-create (car buffers))) + (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)))) @@ -84,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)))) @@ -98,25 +133,36 @@ (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) (riece-with-server-buffer (riece-identity-server target) (let ((topic (riece-channel-get-topic (riece-identity-prefix target)))) - (if topic - (concat string ": " topic) - string)))) + (if (or (null topic) + (equal topic "")) + string + (concat string ": " topic))))) (defun riece-concat-channel-modes (target string) (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) @@ -128,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) @@ -158,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)