X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Friece-user.el;h=c780e61de5d0d0ea6aa423cdc74d159d76c6031a;hb=04d07d1323a22551174bab3b7e36144823824392;hp=f74f770facf0729aa361765e2fca2714e307554e;hpb=dccec42b66251dd099328c5c462d8eb7eb20e840;p=riece diff --git a/lisp/riece-user.el b/lisp/riece-user.el index f74f770..c780e61 100644 --- a/lisp/riece-user.el +++ b/lisp/riece-user.el @@ -18,61 +18,62 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; 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) +(require 'riece-cache) ;;; 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))) - (if symbol - (symbol-value symbol))))) + (riece-cache-get riece-user-cache name) + (let ((symbol (intern-soft (riece-identity-canonicalize-prefix name) + riece-user-obarray))) + (if 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))))) + (riece-cache-delete riece-user-cache name) + (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 - (unless (equal (downcase (riece-identity-prefix old-name)) - (downcase (riece-identity-prefix new-name))) - (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) + (riece-cache-delete riece-user-cache old-name) + (riece-cache-set riece-user-cache new-name new-name) + (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)))))) + (progn + (riece-cache-get riece-user-cache name) + (symbol-value symbol)) + (riece-cache-set riece-user-cache name name) + (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." @@ -90,6 +91,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)) @@ -106,25 +111,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-user-at-host (&optional name) - (riece-user-user-at-host - (riece-get-user (or name riece-real-nickname)))) +(defun riece-user-get-channels (name) + (riece-user-channels (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-user-at-host (name) + (riece-user-user-at-host (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-modes (name) + (riece-user-modes (riece-get-user name))) + +(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) @@ -134,14 +142,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