X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;ds=sidebyside;f=lisp%2Friece-user.el;h=9ad4ee101aecbfff5c360fd34019dcfe83494d02;hb=f959ec471f5b01106b24df737036ce233b38b64b;hp=e584b7446179ee547f804570eda33fe0d32c9c88;hpb=fe7ce5e9a344721b1ecdd4d9ec1adce5dc908a49;p=riece diff --git a/lisp/riece-user.el b/lisp/riece-user.el index e584b74..9ad4ee1 100644 --- a/lisp/riece-user.el +++ b/lisp/riece-user.el @@ -23,54 +23,49 @@ ;;; Code: -(eval-when-compile (require 'riece-inlines)) ;string-assoc-ignore-case, etc. - (require 'riece-identity) - -(defconst riece-user-regexp - "[][\\\\`_^{|}A-Za-z][][\\\\`_^{|}A-Za-z0-9-]\\{0,8\\}") +(require 'riece-mode) ;;; User object: (defun riece-find-user (name) "Get a user object named NAME from the server buffer." - (riece-with-server-buffer - (let ((symbol (intern-soft (downcase (riece-identity-prefix name)) - riece-obarray))) + (let ((symbol (intern-soft (riece-identity-canonicalize-prefix name) + riece-user-obarray))) (if symbol - (symbol-value symbol))))) + (symbol-value symbol)))) (defun riece-forget-user (name) - (riece-with-server-buffer - (let ((symbol (intern-soft (downcase (riece-identity-prefix name))))) - (when symbol - (makunbound symbol) - (unintern (symbol-name symbol) riece-obarray))))) + (let ((symbol (intern-soft (riece-identity-canonicalize-prefix name)))) + (when symbol + (makunbound symbol) + (unintern (symbol-name symbol) riece-user-obarray)))) (defun riece-rename-user (old-name new-name) - (riece-with-server-buffer - (let ((symbol (intern-soft (downcase (riece-identity-prefix old-name)) - riece-obarray))) - (when symbol - (set (intern (downcase (riece-identity-prefix new-name)) - riece-obarray) - (symbol-value symbol)) - (makunbound symbol) - (unintern (symbol-name symbol) riece-obarray))))) - -(defun riece-make-user (&optional channels user-at-host modes away) + (unless (equal (riece-identity-canonicalize-prefix old-name) + (riece-identity-canonicalize-prefix new-name)) + (let ((symbol (intern-soft (riece-identity-canonicalize-prefix old-name) + riece-user-obarray))) + (when symbol + (set (intern (riece-identity-canonicalize-prefix new-name) + riece-user-obarray) + (symbol-value symbol)) + (makunbound symbol) + (unintern (symbol-name symbol) riece-user-obarray))))) + +(defun riece-make-user (channels user-at-host modes away operator) "Make an instance of user object. Arguments are appropriate to joined channels, user-at-host, mode, and away status, respectively." - (vector channels user-at-host modes away)) + (vector channels user-at-host modes away operator)) (defun riece-get-user (name) - (riece-with-server-buffer - (let ((symbol (intern-soft (downcase (riece-identity-prefix name)) - riece-obarray))) + (let ((symbol (intern-soft (riece-identity-canonicalize-prefix name) + riece-user-obarray))) (if symbol (symbol-value symbol) - (set (intern (downcase (riece-identity-prefix name)) riece-obarray) - (riece-make-user)))))) + (set (intern (riece-identity-canonicalize-prefix name) + riece-user-obarray) + (riece-make-user nil nil nil nil nil))))) (defun riece-user-channels (user) "Return joined channels of USER." @@ -88,6 +83,10 @@ away status, respectively." "Return t, if USER has been marked as away." (aref user 3)) +(defun riece-user-operator (user) + "Return t, if USER has operator privilege." + (aref user 4)) + (defun riece-user-set-channels (user value) "Set the joined channels of USER to VALUE." (aset user 0 value)) @@ -104,42 +103,52 @@ away status, respectively." "Set the away status of USER to VALUE." (aset user 3 value)) -(defun riece-user-get-channels (&optional name) - (riece-user-channels - (riece-get-user (or name riece-real-nickname)))) +(defun riece-user-set-operator (user value) + "Set the operator status of USER to VALUE." + (aset user 4 value)) + +(defun riece-user-get-channels (name) + (riece-user-channels (riece-get-user name))) -(defun riece-user-get-user-at-host (&optional name) - (riece-user-user-at-host - (riece-get-user (or name riece-real-nickname)))) +(defun riece-user-get-user-at-host (name) + (riece-user-user-at-host (riece-get-user name))) -(defun riece-user-get-modes (&optional name) - (riece-user-modes - (riece-get-user (or name riece-real-nickname)))) +(defun riece-user-get-modes (name) + (riece-user-modes (riece-get-user name))) -(defun riece-user-get-away (&optional name) - (riece-user-away - (riece-get-user (or name riece-real-nickname)))) +(defun riece-user-get-away (name) + (riece-user-away (riece-get-user name))) + +(defun riece-user-get-operator (name) + (riece-user-operator (riece-get-user name))) (defun riece-user-toggle-channel (name channel flag) "Add or remove the joined channel of user." - (let* ((user (riece-get-user (or name (riece-current-nickname)))) + (let* ((user (riece-get-user name)) (channels (riece-user-channels user))) (if flag - (unless (memq channel channels) + (unless (member channel channels) (riece-user-set-channels user (cons channel channels))) (if (setq channel (car (member channel channels))) (riece-user-set-channels user (delq channel channels)))))) (defun riece-user-toggle-mode (name mode flag) "Add or remove user MODE of user." - (let* ((user (riece-get-user (or name (riece-current-nickname)))) - (modes (riece-user-modes user))) + (let* ((user (riece-get-user name)) + (modes (riece-user-modes user)) + (old (riece-mode-assoc (riece-mode-flag mode) modes))) (if flag - (unless (memq mode modes) + (unless old (riece-user-set-modes user (cons mode modes))) - (if (memq mode modes) + (if old (riece-user-set-modes user (delq mode modes)))))) +(defun riece-user-toggle-away (name flag) + (riece-user-set-away (riece-get-user name) flag)) + +(defun riece-user-toggle-operator (name flag) + (riece-user-set-operator (riece-get-user name) flag)) + (provide 'riece-user) ;;; riece-user.el ends here