X-Git-Url: https://cgit.sxemacs.org/?p=riece;a=blobdiff_plain;f=lisp%2Friece-misc.el;h=eb0de2079ee87cf85d843ae440cd7ffd469253c1;hp=bc68892884a7669a1734497d60a617f71aa5d2a0;hb=a0b576c2225bad55b58b7646314c0194172a4742;hpb=30d51f630920fb7e215af86f2ab8e9fa3c534289 diff --git a/lisp/riece-misc.el b/lisp/riece-misc.el index bc68892..eb0de20 100644 --- a/lisp/riece-misc.el +++ b/lisp/riece-misc.el @@ -24,36 +24,65 @@ ;;; Code: -(eval-when-compile (require 'riece-inlines)) - (require 'riece-options) (require 'riece-coding) (require 'riece-identity) (require 'riece-version) (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)))) @@ -80,16 +109,21 @@ (with-current-buffer buffer (eq riece-freeze 'own))) -(defun riece-process-send-string (process string) - (with-current-buffer (process-buffer process) - (process-send-string process (riece-encode-coding-string string)))) +(defun riece-channel-p (string) + "Return t if STRING is a channel. +\(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-send-string (string) - (let ((process (riece-find-server-process))) - (unless process - (error "%s" (substitute-command-keys - "Type \\[riece-command-open-server] to open server."))) - (riece-process-send-string process string))) +(defun riece-current-nickname () + "Return the current nickname." + (riece-with-server-buffer (riece-current-server-name) + (if riece-real-nickname + (riece-make-identity riece-real-nickname riece-server-name)))) (defun riece-split-parameters (string) (if (eq ?: (aref string 0)) @@ -99,26 +133,37 @@ (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-modes (target string) - (let ((modes - (if (riece-channel-p target) - (riece-channel-get-modes target) - (riece-user-get-modes target)))) - (if modes - (concat string " [" (apply #'string modes) "]") - string))) - -(defsubst riece-concat-current-channel-modes (string) - (if riece-current-channel - (riece-concat-modes riece-current-channel string) - string)) +(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 (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 " [" + (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) (if (or (null message) @@ -127,10 +172,18 @@ (concat string " (" message ")"))) (defun riece-concat-server-name (string) - (riece-with-server-buffer - (if riece-server-name - (concat string " (from " riece-server-name ")") - string))) + (if (equal riece-server-name "") + string + (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) @@ -160,17 +213,40 @@ (substring user-at-host 1) user-at-host)) -(defun riece-get-users-on-server () - (riece-with-server-buffer - (let (users) - (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))))) +(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 (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)