From: ueno Date: Mon, 4 Aug 2003 01:47:11 +0000 (+0000) Subject: * riece-filter.el (riece-handle-numeric-reply): Decode messages. X-Git-Tag: strict-naming-mergepoint~4 X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=a563c2cfe800054407c63ccab4dd636f95b30e9e;p=elisp%2Friece.git * riece-filter.el (riece-handle-numeric-reply): Decode messages. (riece-handle-message): Ditto. * riece-identity.el (riece-abbrev-identity-string-function): New variable. (riece-expand-identity-string-function): New variable. (riece-format-identity): Rename from riece-decode-identity. (riece-parse-identity): Rename from riece-encode-identity. (riece-with-identity-buffer): Abolish. (riece-identity-canonicalize-prefix): Use case-table. * riece-alias.el: New add-on. * COMPILE (riece-modules): Add riece-alias. * Makefile.am (EXTRA_DIST): Add riece-alias.el. * riece-identity.el (riece-with-identity-buffer): Use riece-with-server-buffer. * riece-emacs.el (riece-set-case-syntax-pair): New alias. * riece-xemacs.el (riece-set-case-syntax-pair): New alias. * riece-identity.el (riece-identity-canonicalize-prefix): Simplified. --- diff --git a/lisp/COMPILE b/lisp/COMPILE index 0d09239..60afb3d 100644 --- a/lisp/COMPILE +++ b/lisp/COMPILE @@ -44,7 +44,8 @@ riece-rdcc riece-url riece-unread - riece-doctor)))) + riece-doctor + riece-alias)))) (defun riece-compile-modules (modules) (let ((load-path (cons nil load-path))) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index bec40a4..20bbe10 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,27 @@ +2003-08-04 Daiki Ueno + + * riece-filter.el (riece-handle-numeric-reply): Decode messages. + (riece-handle-message): Ditto. + + * riece-identity.el (riece-abbrev-identity-string-function): New + variable. + (riece-expand-identity-string-function): New variable. + (riece-format-identity): Rename from riece-decode-identity. + (riece-parse-identity): Rename from riece-encode-identity. + (riece-with-identity-buffer): Abolish. + (riece-identity-canonicalize-prefix): Use case-table. + + * riece-alias.el: New add-on. + * COMPILE (riece-modules): Add riece-alias. + * Makefile.am (EXTRA_DIST): Add riece-alias.el. + + * riece-identity.el (riece-with-identity-buffer): Use + riece-with-server-buffer. + + * riece-emacs.el (riece-set-case-syntax-pair): New alias. + * riece-xemacs.el (riece-set-case-syntax-pair): New alias. + * riece-identity.el (riece-identity-canonicalize-prefix): Simplified. + 2003-06-23 Daiki Ueno * riece-misc.el (riece-channel-p): Moved from riece-channel.el. diff --git a/lisp/Makefile.am b/lisp/Makefile.am index ed50ab6..534813a 100644 --- a/lisp/Makefile.am +++ b/lisp/Makefile.am @@ -7,7 +7,7 @@ EXTRA_DIST = COMPILE ChangeLog ChangeLog.Liece \ riece-options.el riece-server.el riece-user.el riece-version.el \ riece-xemacs.el riece.el \ riece-ctcp.el riece-url.el riece-unread.el \ - riece-ndcc.el riece-rdcc.el riece-doctor.el + riece-ndcc.el riece-rdcc.el riece-doctor.el riece-alias.el CLEANFILES = auto-autoloads.el custom-load.el *.elc FLAGS ?= -batch -q -no-site-file diff --git a/lisp/riece-300.el b/lisp/riece-300.el index 3f52d56..499a98f 100644 --- a/lisp/riece-300.el +++ b/lisp/riece-300.el @@ -54,7 +54,7 @@ (concat (riece-concat-server-name (format "%s is (%s) [%s, %s]" - (riece-decode-identity + (riece-format-identity (riece-make-identity user riece-server-name) t) (riece-strip-user-at-host user-at-host) @@ -77,7 +77,7 @@ (concat "Online: " (mapconcat (lambda (user) - (riece-decode-identity + (riece-format-identity (riece-make-identity user riece-server-name) t)) (split-string (substring string 1) " ") @@ -87,15 +87,14 @@ (defun riece-handle-301-message (prefix number name string) (if (string-match (concat "^\\(" riece-user-regexp "\\) :") string) (let ((user (match-string 1 string)) - (message (riece-decode-coding-string - (substring string (match-end 0))))) + (message (substring string (match-end 0)))) (riece-user-toggle-away user t) (riece-insert-info (list riece-dialogue-buffer riece-others-buffer) (concat (riece-concat-server-name (format "%s is away: %s" - (riece-decode-identity + (riece-format-identity (riece-make-identity user riece-server-name) t) message)) @@ -127,10 +126,10 @@ (concat (riece-concat-server-name (format "%s is %s (%s)" - (riece-decode-identity + (riece-format-identity (riece-make-identity user riece-server-name) t) - (riece-decode-coding-string name) + name user-at-host)) "\n"))))) @@ -154,7 +153,7 @@ (list riece-dialogue-buffer riece-others-buffer) (concat (riece-concat-server-name - (concat (riece-decode-identity + (concat (riece-format-identity (riece-make-identity user riece-server-name) t) " is an IRC operator")) @@ -171,7 +170,7 @@ (concat (riece-concat-server-name (format "%s is %s seconds idle" - (riece-decode-identity + (riece-format-identity (riece-make-identity user riece-server-name) t) idle)) @@ -217,8 +216,7 @@ (if (string-match "^\\([^ ]+\\) \\([0-9]+\\) :" string) (let* ((channel (match-string 1 string)) (visible (match-string 2 string)) - (topic (riece-decode-coding-string - (substring string (match-end 0))))) + (topic (substring string (match-end 0)))) (riece-channel-set-topic (riece-get-channel channel) topic) (let* ((channel-identity (riece-make-identity channel riece-server-name)) @@ -233,7 +231,7 @@ (concat (riece-concat-server-name (format "%s users on %s, topic: %s" visible - (riece-decode-identity channel-identity t) topic)) + (riece-format-identity channel-identity t) topic)) "\n")))))) (defun riece-handle-324-message (prefix number name string) @@ -258,7 +256,7 @@ (concat (riece-concat-server-name (format "Mode for %s: %s" - (riece-decode-identity channel-identity t) + (riece-format-identity channel-identity t) mode-string)) "\n"))) (riece-update-channel-indicator) @@ -267,8 +265,7 @@ (defun riece-handle-set-topic (prefix number name string remove) (if (string-match "^\\([^ ]+\\) :" string) (let* ((channel (match-string 1 string)) - (message (riece-decode-coding-string - (substring string (match-end 0)))) + (message (substring string (match-end 0))) (channel-identity (riece-make-identity channel riece-server-name)) (buffer (riece-channel-buffer-name channel-identity))) (if remove @@ -283,7 +280,7 @@ (concat (riece-concat-server-name (format "Topic for %s: %s" - (riece-decode-identity channel-identity t) + (riece-format-identity channel-identity t) message)) "\n")) (riece-update-channel-indicator))))) @@ -309,7 +306,7 @@ (concat (riece-concat-server-name (format "Inviting %s to %s" user - (riece-decode-identity channel-identity t))) + (riece-format-identity channel-identity t))) "\n"))))) (defun riece-handle-352-message (prefix number name string) @@ -323,8 +320,7 @@ (operator (not (null (match-beginning 7)))) (flag (match-string 8 string)) (hops (match-string 9 string)) - (name (riece-decode-coding-string - (substring string (match-end 0)))) + (name (substring string (match-end 0))) (buffer (riece-channel-buffer-name (riece-make-identity channel riece-server-name))) (info (format "%10s = %s (%s) [%s, %s, %s hops, on %s]" @@ -332,10 +328,10 @@ (if (memq flag '(?@ ?+)) (char-to-string flag) " ") - (riece-decode-identity + (riece-format-identity (riece-make-identity nick riece-server-name) t)) - (riece-decode-coding-string name) + name (riece-strip-user-at-host (concat user "@" host)) (if operator @@ -358,7 +354,7 @@ (concat (riece-concat-server-name (concat - (riece-decode-identity + (riece-format-identity (riece-make-identity channel riece-server-name) t) " " diff --git a/lisp/riece-alias.el b/lisp/riece-alias.el new file mode 100644 index 0000000..0613bc7 --- /dev/null +++ b/lisp/riece-alias.el @@ -0,0 +1,90 @@ +;;; riece-alias.el --- define aliases of names +;; Copyright (C) 1998-2003 Daiki Ueno + +;; Author: Daiki Ueno +;; Keywords: IRC, riece + +;; This file is part of Riece. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; 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. + +;;; Code: + +(defgroup riece-alias nil + "Define aliases of names" + :prefix "riece-" + :group 'riece) + +(defcustom riece-alias-percent-hack-mask "*.jp" + "The mask of local IRC network" + :type 'string + :group 'riece-alias) + +(defcustom riece-alias-enable-percent-hack t + "If non-nil, the target mask is abbreviated with `%'." + :type 'boolean + :group 'riece-alias) + +(defcustom riece-alias-alist nil + "An alist mapping aliases to names." + :type 'list + :group 'riece-alias) + +(defun riece-alias-abbrev-percent-hack (string) + (if (string-match (concat "^#\\([^ ]+\\):" + (regexp-quote riece-alias-percent-hack-mask) + "\\( .+\\|$\\)") + string) + (replace-match "%\\1\\2" nil nil string) + string)) + +(defun riece-alias-expand-percent-hack (string) + (if (string-match "^%\\([^ ]+\\)\\( .+\\|$\\)" string) + (replace-match (concat "#\\1:" riece-alias-percent-hack-mask "\\2") + nil nil string) + string)) + +(defun riece-alias-abbrev-identity-string (string) + (if riece-alias-enable-percent-hack + (setq string (riece-alias-abbrev-percent-hack string))) + (let ((alist riece-alias-alist)) + (catch 'done + (while alist + (if (equal (car (car alist)) string) + (throw 'done (cdr (car alist)))) + (setq alist (cdr alist))) + string))) + +(defun riece-alias-expand-identity-string (string) + (if riece-alias-enable-percent-hack + (setq string (riece-alias-expand-percent-hack string))) + (let ((alist riece-alias-alist)) + (catch 'done + (while alist + (if (equal (cdr (car alist)) string) + (throw 'done (car (car alist)))) + (setq alist (cdr alist))) + string))) + +(defun riece-alias-insinuate () + (setq riece-abbrev-identity-string-function + #'riece-alias-abbrev-identity-string + riece-expand-identity-string-function + #'riece-alias-expand-identity-string)) + +(provide 'riece-alias) + +;;; riece-alias.el ends here diff --git a/lisp/riece-commands.el b/lisp/riece-commands.el index 9a04b89..6123263 100644 --- a/lisp/riece-commands.el +++ b/lisp/riece-commands.el @@ -146,7 +146,8 @@ (defun riece-command-topic (topic) (interactive (list (read-from-minibuffer - "Topic: " (cons (or (riece-with-identity-buffer riece-current-channel + "Topic: " (cons (or (riece-with-server-buffer + (riece-identity-server riece-current-channel) (riece-channel-get-topic (riece-identity-prefix riece-current-channel))) @@ -200,7 +201,7 @@ (if (and riece-current-channel (riece-channel-p (riece-identity-prefix riece-current-channel))) - (cons (riece-decode-identity riece-current-channel t) + (cons (riece-format-identity riece-current-channel t) 0)))))) (if (or (not (equal pattern "")) (yes-or-no-p "Really want to query NAMES without argument? ")) @@ -214,7 +215,7 @@ (if (and riece-current-channel (riece-channel-p (riece-identity-prefix riece-current-channel))) - (cons (riece-decode-identity riece-current-channel t) + (cons (riece-format-identity riece-current-channel t) 0)))))) (if (or (not (equal pattern "")) (yes-or-no-p "Really want to query WHO without argument? ")) @@ -228,7 +229,7 @@ (if (and riece-current-channel (riece-channel-p (riece-identity-prefix riece-current-channel))) - (cons (riece-decode-identity riece-current-channel t) + (cons (riece-format-identity riece-current-channel t) 0)))))) (if (or (not (equal pattern "")) (yes-or-no-p "Really want to query LIST without argument? ")) @@ -263,7 +264,8 @@ (defun riece-command-set-operators (users &optional arg) (interactive (let ((operators - (riece-with-identity-buffer riece-current-channel + (riece-with-server-buffer + (riece-identity-server riece-current-channel) (riece-channel-get-operators (riece-identity-prefix riece-current-channel)))) (completion-ignore-case t) @@ -278,8 +280,9 @@ (lambda (user) (unless (member user operators) (list user))) - (riece-with-identity-buffer - riece-current-channel + (riece-with-server-buffer + (riece-identity-server + riece-current-channel) (riece-channel-get-users (riece-identity-prefix riece-current-channel)))))))) @@ -302,7 +305,8 @@ (defun riece-command-set-speakers (users &optional arg) (interactive (let ((speakers - (riece-with-identity-buffer riece-current-channel + (riece-with-server-buffer + (riece-identity-server riece-current-channel) (riece-channel-get-speakers (riece-identity-prefix riece-current-channel)))) (completion-ignore-case t) @@ -317,8 +321,9 @@ (lambda (user) (unless (member user speakers) (list user))) - (riece-with-identity-buffer - riece-current-channel + (riece-with-server-buffer + (riece-identity-server + riece-current-channel) (riece-channel-get-users (riece-identity-prefix riece-current-channel)))))))) @@ -441,7 +446,7 @@ (target (riece-completing-read-identity "Channel/User: " riece-current-channels nil nil - (cons (riece-decode-identity riece-current-channel) 0))) + (cons (riece-format-identity riece-current-channel) 0))) message) (if (and current-prefix-arg (riece-channel-p (riece-identity-prefix target))) diff --git a/lisp/riece-compat.el b/lisp/riece-compat.el index bcc82ac..ef41c10 100644 --- a/lisp/riece-compat.el +++ b/lisp/riece-compat.el @@ -24,6 +24,10 @@ ;;; Code: +(if (featurep 'xemacs) + (require 'riece-xemacs) + (require 'riece-emacs)) + (defalias 'riece-mode-line-buffer-identification 'identity) diff --git a/lisp/riece-display.el b/lisp/riece-display.el index db6804f..f3358a8 100644 --- a/lisp/riece-display.el +++ b/lisp/riece-display.el @@ -157,7 +157,7 @@ Local to the buffers.") (if (car channels) (let ((point (point))) (insert (format "%2d: %s\n" index - (riece-decode-identity (car channels)))) + (riece-format-identity (car channels)))) (put-text-property point (point) 'riece-identity (car channels)))) (setq index (1+ index) @@ -172,14 +172,14 @@ Local to the buffers.") riece-current-channel (riece-concat-channel-topic riece-current-channel - (riece-decode-identity riece-current-channel))) - (riece-decode-identity riece-current-channel)) + (riece-format-identity riece-current-channel))) + (riece-format-identity riece-current-channel)) "None"))) (defun riece-update-short-channel-indicator () (setq riece-short-channel-indicator (if riece-current-channel - (riece-decode-identity riece-current-channel) + (riece-format-identity riece-current-channel) "None"))) (defun riece-update-channel-list-indicator () @@ -195,7 +195,7 @@ Local to the buffers.") (lambda (channel) (prog1 (if channel (format "%d:%s" index - (riece-decode-identity channel))) + (riece-format-identity channel))) (setq index (1+ index)))) riece-current-channels)) ","))) @@ -235,7 +235,7 @@ Local to the buffers.") (force-mode-line-update t)) (defun riece-channel-buffer-name (identity) - (format riece-channel-buffer-format (riece-decode-identity identity))) + (format riece-channel-buffer-format (riece-format-identity identity))) (eval-when-compile (autoload 'riece-channel-mode "riece")) diff --git a/lisp/riece-doctor.el b/lisp/riece-doctor.el index a2101b6..c922c9e 100644 --- a/lisp/riece-doctor.el +++ b/lisp/riece-doctor.el @@ -51,7 +51,7 @@ (autoload 'doctor-read-print "doctor") (defun riece-doctor-buffer-name (user) - (concat " *riece-doctor*" (riece-decode-identity user))) + (concat " *riece-doctor*" (riece-format-identity user))) (defun riece-doctor-reply (target string) (riece-display-message diff --git a/lisp/riece-emacs.el b/lisp/riece-emacs.el index eb13289..e46f8c5 100644 --- a/lisp/riece-emacs.el +++ b/lisp/riece-emacs.el @@ -24,6 +24,9 @@ ;;; Code: +(defalias 'riece-set-case-syntax-pair + 'set-case-syntax-pair) + (provide 'riece-emacs) ;;; riece-emacs.el ends here diff --git a/lisp/riece-filter.el b/lisp/riece-filter.el index f468dd9..fb8894d 100644 --- a/lisp/riece-filter.el +++ b/lisp/riece-filter.el @@ -45,7 +45,8 @@ (if (and function (symbol-function function)) (condition-case error - (funcall function prefix number name string) + (funcall function prefix number name + (riece-decode-coding-string string)) (error (if riece-debug (message "Error occurred in `%S': %S" function error))))))) @@ -56,8 +57,7 @@ (list riece-dialogue-buffer riece-others-buffer) (concat client-prefix (riece-concat-server-name - (mapconcat #'riece-decode-coding-string - (riece-split-parameters string) " ")) + (mapconcat #'identity (riece-split-parameters string) " ")) "\n"))) (defun riece-handle-message (prefix message string) @@ -66,7 +66,8 @@ (riece-user-set-user-at-host (riece-get-user (substring prefix 0 (match-beginning 0))) (riece-parse-user-at-host (substring prefix (1+ (match-beginning 0)))))) - (setq message (downcase message)) + (setq message (downcase message) + string (riece-decode-coding-string string)) (let ((function (intern-soft (concat "riece-handle-" message "-message"))) (hook (intern (concat "riece-" message "-hook"))) (after-hook (intern (concat "riece-after-" message "-hook")))) diff --git a/lisp/riece-handle.el b/lisp/riece-handle.el index b9ad13d..2ca23eb 100644 --- a/lisp/riece-handle.el +++ b/lisp/riece-handle.el @@ -57,16 +57,16 @@ (riece-make-identity channel riece-server-name))) channels) (format "%s -> %s\n" - (riece-decode-identity old-identity t) - (riece-decode-identity new-identity t))) + (riece-format-identity old-identity t) + (riece-format-identity new-identity t))) (riece-insert-change (if visible riece-dialogue-buffer (list riece-dialogue-buffer riece-others-buffer)) (concat (riece-concat-server-name (format "%s -> %s" - (riece-decode-identity old-identity t) - (riece-decode-identity new-identity t))) + (riece-format-identity old-identity t) + (riece-format-identity new-identity t))) "\n")) (riece-redisplay-buffers))) @@ -74,7 +74,7 @@ (let* ((user (riece-prefix-nickname prefix)) (parameters (riece-split-parameters string)) (targets (split-string (car parameters) ",")) - (message (riece-decode-coding-string (nth 1 parameters)))) + (message (nth 1 parameters))) (riece-display-message (riece-make-message (riece-make-identity user riece-server-name) @@ -87,7 +87,7 @@ (riece-prefix-nickname prefix))) (parameters (riece-split-parameters string)) (targets (split-string (car parameters) ",")) - (message (riece-decode-coding-string (nth 1 parameters)))) + (message (nth 1 parameters))) (if user (riece-display-message (riece-make-message (riece-make-identity user @@ -121,9 +121,9 @@ (riece-insert-change buffer (format "%s (%s) has joined %s\n" - (riece-decode-identity user-identity t) + (riece-format-identity user-identity t) (riece-user-get-user-at-host user) - (riece-decode-identity channel-identity t))) + (riece-format-identity channel-identity t))) (riece-insert-change (if (and riece-channel-buffer-mode (not (eq buffer riece-channel-buffer))) @@ -132,9 +132,9 @@ (concat (riece-concat-server-name (format "%s (%s) has joined %s" - (riece-decode-identity user-identity t) + (riece-format-identity user-identity t) (riece-user-get-user-at-host user) - (riece-decode-identity channel-identity t))) + (riece-format-identity channel-identity t))) "\n"))) (setq channels (cdr channels))) (riece-redisplay-buffers))) @@ -145,8 +145,7 @@ ;; RFC2812 3.2.2 doesn't recommend server to send part ;; messages which contain multiple targets. (channels (split-string (car parameters) ",")) - (message (if (nth 1 parameters) - (riece-decode-coding-string (nth 1 parameters)))) + (message (nth 1 parameters)) (user-identity (riece-make-identity user riece-server-name))) (while channels (riece-naming-assert-part user (car channels)) @@ -159,8 +158,8 @@ (concat (riece-concat-message (format "%s has left %s" - (riece-decode-identity user-identity t) - (riece-decode-identity channel-identity t)) + (riece-format-identity user-identity t) + (riece-format-identity channel-identity t)) message) "\n")) (riece-insert-change @@ -172,8 +171,8 @@ (riece-concat-server-name (riece-concat-message (format "%s has left %s" - (riece-decode-identity user-identity t) - (riece-decode-identity channel-identity t)) + (riece-format-identity user-identity t) + (riece-format-identity channel-identity t)) message)) "\n"))) (setq channels (cdr channels))) @@ -184,8 +183,7 @@ (parameters (riece-split-parameters string)) (channel (car parameters)) (user (nth 1 parameters)) - (message (if (nth 2 parameters) - (riece-decode-coding-string (nth 2 parameters)))) + (message (nth 2 parameters)) (kicker-identity (riece-make-identity kicker riece-server-name)) (channel-identity (riece-make-identity channel riece-server-name)) (user-identity (riece-make-identity user riece-server-name))) @@ -196,9 +194,9 @@ (concat (riece-concat-message (format "%s kicked %s out from %s" - (riece-decode-identity kicker-identity t) - (riece-decode-identity user-identity t) - (riece-decode-identity channel-identity t)) + (riece-format-identity kicker-identity t) + (riece-format-identity user-identity t) + (riece-format-identity channel-identity t)) message) "\n")) (riece-insert-change @@ -210,9 +208,9 @@ (riece-concat-server-name (riece-concat-message (format "%s kicked %s out from %s\n" - (riece-decode-identity kicker-identity t) - (riece-decode-identity user-identity t) - (riece-decode-identity channel-identity t)) + (riece-format-identity kicker-identity t) + (riece-format-identity user-identity t) + (riece-format-identity channel-identity t)) message)) "\n"))) (riece-redisplay-buffers))) @@ -222,8 +220,7 @@ (channels (copy-sequence (riece-user-get-channels user))) (pointer channels) (parameters (riece-split-parameters string)) - (message (if (car parameters) - (riece-decode-coding-string (car parameters)))) + (message (car parameters)) (user-identity (riece-make-identity user riece-server-name))) ;; If you are talking with the user, quit it. (if (riece-identity-member user-identity riece-current-channels) @@ -244,7 +241,7 @@ (concat (riece-concat-message (format "%s has left IRC" - (riece-decode-identity user-identity t)) + (riece-format-identity user-identity t)) message) "\n")) (riece-insert-change @@ -256,7 +253,7 @@ (riece-concat-server-name (riece-concat-message (format "%s has left IRC" - (riece-decode-identity user-identity t)) + (riece-format-identity user-identity t)) message)) "\n")))) (riece-redisplay-buffers)) @@ -265,8 +262,7 @@ (let* ((killer (riece-prefix-nickname prefix)) (parameters (riece-split-parameters string)) (user (car parameters)) - (message (if (nth 1 parameters) - (riece-decode-coding-string (nth 1 parameters)))) + (message (nth 1 parameters)) (channels (copy-sequence (riece-user-get-channels user))) (killer-identity (riece-make-identity killer riece-server-name)) (user-identity (riece-make-identity user riece-server-name)) @@ -290,8 +286,8 @@ (concat (riece-concat-message (format "%s killed %s" - (riece-decode-identity killer-identity t) - (riece-decode-identity user-identity t)) + (riece-format-identity killer-identity t) + (riece-format-identity user-identity t)) message) "\n")) (riece-insert-change @@ -303,8 +299,8 @@ (riece-concat-server-name (riece-concat-message (format "%s killed %s" - (riece-decode-identity killer-identity t) - (riece-decode-identity user-identity t)) + (riece-format-identity killer-identity t) + (riece-format-identity user-identity t)) message)) "\n"))) (riece-redisplay-buffers))) @@ -318,9 +314,9 @@ (concat (riece-concat-server-name (format "%s invites you to %s" - (riece-decode-identity (riece-make-identity + (riece-format-identity (riece-make-identity user riece-server-name)) - (riece-decode-identity (riece-make-identity + (riece-format-identity (riece-make-identity channel riece-server-name)))) "\n")))) @@ -328,7 +324,7 @@ (let* ((user (riece-prefix-nickname prefix)) (parameters (riece-split-parameters string)) (channel (car parameters)) - (topic (riece-decode-coding-string (nth 1 parameters))) + (topic (nth 1 parameters)) (user-identity (riece-make-identity user riece-server-name)) (channel-identity (riece-make-identity channel riece-server-name))) (riece-channel-set-topic (riece-get-channel channel) topic) @@ -336,7 +332,7 @@ (riece-insert-change buffer (format "Topic by %s: %s\n" - (riece-decode-identity user-identity t) + (riece-format-identity user-identity t) topic)) (riece-insert-change (if (and riece-channel-buffer-mode @@ -346,8 +342,8 @@ (concat (riece-concat-server-name (format "Topic on %s by %s: %s" - (riece-decode-identity channel-identity t) - (riece-decode-identity user-identity t) + (riece-format-identity channel-identity t) + (riece-format-identity user-identity t) topic)) "\n")) (riece-redisplay-buffers)))) @@ -396,7 +392,7 @@ (riece-insert-change buffer (format "Mode by %s: %s\n" - (riece-decode-identity user-identity t) + (riece-format-identity user-identity t) string)) (riece-insert-change (if (and riece-channel-buffer-mode @@ -406,8 +402,8 @@ (concat (riece-concat-server-name (format "Mode on %s by %s: %s" - (riece-decode-identity channel-identity t) - (riece-decode-identity user-identity t) + (riece-format-identity channel-identity t) + (riece-format-identity user-identity t) string)) "\n")) (riece-redisplay-buffers))))) diff --git a/lisp/riece-identity.el b/lisp/riece-identity.el index b054edc..92382db 100644 --- a/lisp/riece-identity.el +++ b/lisp/riece-identity.el @@ -32,6 +32,9 @@ "Return the component sans its server from IDENTITY." (aref identity 0)) +(defvar riece-abbrev-identity-string-function nil) +(defvar riece-expand-identity-string-function nil) + (defun riece-identity-server (identity) "Return the server component in IDENTITY." (aref identity 1)) @@ -51,28 +54,24 @@ (defun riece-identity-canonicalize-prefix (prefix) "Canonicalize identity PREFIX. -This function downcases PREFIX first, then does special treatment for -Scandinavian alphabets. +This function downcases PREFIX with Scandinavian alphabet rule. RFC2812, 2.2 \"Character codes\" says: Because of IRC's Scandinavian origin, the characters {}|^ are considered to be the lower case equivalents of the characters []\~, respectively. This is a critical issue when determining the equivalence of two nicknames or channel names." - (let* ((result (downcase prefix)) - (length (length result)) - (index 0)) - (while (< index length) - (if (eq (aref result index) ?\[) - (aset result index ?{) - (if (eq (aref result index) ?\]) - (aset result index ?}) - (if (eq (aref result index) ?\\) - (aset result index ?|) - (if (eq (aref result index) ?~) - (aset result index ?^))))) - (setq index (1+ index))) - result)) + (let* ((old (current-case-table)) + (new (copy-case-table old))) + (unwind-protect + (progn + (riece-set-case-syntax-pair ?\[ ?{ new) + (riece-set-case-syntax-pair ?\] ?} new) + (riece-set-case-syntax-pair ?\\ ?| new) + (riece-set-case-syntax-pair ?~ ?^ new) + (set-case-table new) + (downcase prefix)) + (set-case-table old)))) (defun riece-identity-equal-no-server (prefix1 prefix2) "Return t, if IDENT1 and IDENT2 is equal without server." @@ -118,57 +117,45 @@ RFC2812, 2.2 \"Character codes\" says: (setcar pointer item) list)) -(defmacro riece-with-identity-buffer (identity &rest body) - `(let ((process (riece-server-process (riece-identity-server ,identity)))) - (if process - (with-current-buffer (process-buffer process) - ,@body) - (error "Server closed")))) - -(put 'riece-with-identity-buffer 'lisp-indent-function 1) - -(defun riece-decode-identity (identity &optional prefix-only) - (riece-with-identity-buffer identity - (let ((prefix (riece-decode-coding-string - (riece-identity-prefix identity))) - (server (riece-identity-server identity))) - (if (or prefix-only (equal server "")) - prefix - (concat prefix " " server))))) - -(defun riece-encode-identity (string) - (let ((prefix (if (string-match " " string) - (substring string 0 (match-beginning 0)) - string)) - (server (if (string-match " " string) - (substring string (match-end 0)) - ""))) - (riece-with-server-buffer server - (riece-make-identity (riece-encode-coding-string prefix) server)))) +(defun riece-format-identity (identity &optional prefix-only) + (let ((string + (if (or prefix-only + (equal (riece-identity-server identity) "")) + (riece-identity-prefix identity) + (concat (riece-identity-prefix identity) " " + (riece-identity-server identity))))) + (if riece-abbrev-identity-string-function + (funcall riece-abbrev-identity-string-function string) + string))) + +(defun riece-parse-identity (string) + (if riece-expand-identity-string-function + (setq string (funcall riece-expand-identity-string-function string))) + (riece-make-identity (if (string-match " " string) + (substring string 0 (match-beginning 0)) + string) + (if (string-match " " string) + (substring string (match-end 0)) + ""))) (defun riece-completing-read-identity (prompt channels &optional predicate must-match initial) - (let* ((decoded + (let* ((string (completing-read prompt (mapcar (lambda (channel) - (list (riece-decode-identity channel))) + (list (riece-format-identity channel))) (delq nil (copy-sequence (or channels riece-current-channels)))) predicate must-match initial)) - (encoded - (riece-encode-identity decoded))) + (identity + (riece-parse-identity string))) (unless (string-match (concat "^\\(" riece-channel-regexp "\\|" riece-user-regexp "\\)") - (riece-identity-prefix encoded)) + (riece-identity-prefix identity)) (error "Invalid channel name!")) - (if (and (not (string-match "[ ,]" decoded)) - (string-match "[ ,]" (riece-identity-prefix encoded)) - (not (y-or-n-p (format "The encoded channel name contains illegal character \"%s\". continue? " - (match-string 0 (riece-identity-prefix encoded)))))) - (error "Invalid channel name!")) - encoded)) + identity)) (provide 'riece-identity) diff --git a/lisp/riece-message.el b/lisp/riece-message.el index a2d1aff..8a20efb 100644 --- a/lisp/riece-message.el +++ b/lisp/riece-message.el @@ -87,18 +87,18 @@ "Make local identity for MESSAGE." (if (riece-message-private-p message) (if (riece-message-own-p message) - (riece-decode-identity (riece-message-target message) t) - (riece-decode-identity (riece-message-speaker message) t)) - (riece-decode-identity (riece-message-speaker message) t))) + (riece-format-identity (riece-message-target message) t) + (riece-format-identity (riece-message-speaker message) t)) + (riece-format-identity (riece-message-speaker message) t))) (defun riece-message-make-global-name (message) "Make global identity for MESSAGE." (if (riece-message-private-p message) (if (riece-message-own-p message) - (riece-decode-identity (riece-message-target message) t) - (riece-decode-identity (riece-message-speaker message) t)) - (concat (riece-decode-identity (riece-message-target message) t) ":" - (riece-decode-identity (riece-message-speaker message) t)))) + (riece-format-identity (riece-message-target message) t) + (riece-format-identity (riece-message-speaker message) t)) + (concat (riece-format-identity (riece-message-target message) t) ":" + (riece-format-identity (riece-message-speaker message) t)))) (defun riece-message-buffer (message) "Return the buffer where MESSAGE should appear." @@ -213,7 +213,7 @@ Currently possible values are `action' and `notice'." (not (riece-identity-member (riece-message-speaker message) (let ((target (riece-message-target message))) - (riece-with-identity-buffer target + (riece-with-server-buffer (riece-identity-server target) (mapcar (lambda (user) (riece-make-identity user riece-server-name)) diff --git a/lisp/riece-misc.el b/lisp/riece-misc.el index a9fc0b8..2ba5785 100644 --- a/lisp/riece-misc.el +++ b/lisp/riece-misc.el @@ -86,7 +86,7 @@ (defun riece-current-nickname () "Return the current nickname." - (riece-with-identity-buffer riece-current-channel + (riece-with-server-buffer (riece-identity-server riece-current-channel) (if riece-real-nickname (riece-make-identity riece-real-nickname riece-server-name)))) @@ -106,14 +106,14 @@ parameters))) (defun riece-concat-channel-topic (target string) - (riece-with-identity-buffer target + (riece-with-server-buffer (riece-identity-server target) (let ((topic (riece-channel-get-topic (riece-identity-prefix target)))) (if topic (concat string ": " topic) string)))) (defun riece-concat-channel-modes (target string) - (riece-with-identity-buffer target + (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) "]") diff --git a/lisp/riece-xemacs.el b/lisp/riece-xemacs.el index 055fa7c..f6b1262 100644 --- a/lisp/riece-xemacs.el +++ b/lisp/riece-xemacs.el @@ -70,6 +70,9 @@ Modify whole identification by side effect." (defalias 'riece-simplify-mode-line-format 'riece-xemacs-simplify-modeline-format) +(defalias 'riece-set-case-syntax-pair + 'put-case-table-pair) + (provide 'riece-xemacs) ;;; riece-xemacs.el ends here diff --git a/lisp/riece.el b/lisp/riece.el index 8a5cd0b..f2a743b 100644 --- a/lisp/riece.el +++ b/lisp/riece.el @@ -24,10 +24,6 @@ ;;; Code: -(if (featurep 'xemacs) - (require 'riece-xemacs) - (require 'riece-emacs)) - (require 'riece-filter) (require 'riece-display) (require 'riece-server)