X-Git-Url: https://cgit.sxemacs.org/?p=riece;a=blobdiff_plain;f=lisp%2Friece-user.el;h=9ad4ee101aecbfff5c360fd34019dcfe83494d02;hp=28d061c9a8e4ee6449cd054975038eed5f63c2b5;hb=71426e800f4b1a6317bef46e4ffd92d836a63f1f;hpb=5080d33d117e57033d5e57d46d6f63625f146738 diff --git a/lisp/riece-user.el b/lisp/riece-user.el index 28d061c..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,25 +103,28 @@ 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 (member channel channels) @@ -132,14 +134,21 @@ away status, respectively." (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