X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Friece-identity.el;h=f7a48cb6bb94cba05065643f10cbaf9421114148;hb=c29e67d9775fc091a53a59d8fb315ef2e05bd46b;hp=0f12d547705f194a164c9d7174c5103a01740bb5;hpb=8494a52113e0e498a2c0e6ff888ddaca095d669b;p=riece diff --git a/lisp/riece-identity.el b/lisp/riece-identity.el index 0f12d54..f7a48cb 100644 --- a/lisp/riece-identity.el +++ b/lisp/riece-identity.el @@ -32,7 +32,7 @@ (defvar riece-expand-identity-string-function nil) (defvar riece-identity-prefix-case-table - (let ((table (copy-case-table (standard-case-table)))) + (let ((table (riece-copy-case-table (standard-case-table)))) (riece-set-case-syntax-pair ?\[ ?{ table) (riece-set-case-syntax-pair ?\] ?} table) (riece-set-case-syntax-pair ?\\ ?| table) @@ -77,26 +77,29 @@ RFC2812, 2.2 \"Character codes\" says: (set-case-table old-table)))) (defun riece-identity-equal-no-server (prefix1 prefix2) - "Return t, if IDENT1 and IDENT2 is equal without server." + "Return t, if IDENT1 and IDENT2 is equal without server part." (equal (riece-identity-canonicalize-prefix prefix1) (riece-identity-canonicalize-prefix prefix2))) -(defun riece-identity-member (elt list) +(defun riece-identity-member (elt list &optional no-server) "Return non-nil if an identity ELT is an element of LIST." (catch 'found (while list - (if (and (vectorp (car list)) ;needed because - ;riece-current-channels - ;contains nil. - (riece-identity-equal (car list) elt)) + (if (and (car list) ;needed because riece-current-channels + ;contains nil. + (if no-server + (riece-identity-equal-no-server (car list) elt) + (riece-identity-equal (car list) elt))) (throw 'found list) (setq list (cdr list)))))) -(defun riece-identity-assoc (elt alist) +(defun riece-identity-assoc (elt alist &optional no-server) "Return non-nil if an identity ELT matches the car of an element of ALIST." (catch 'found (while alist - (if (riece-identity-equal (car (car alist)) elt) + (if (if no-server + (riece-identity-equal-no-server (car (car alist)) elt) + (riece-identity-equal (car (car alist)) elt)) (throw 'found (car alist)) (setq alist (cdr alist)))))) @@ -121,10 +124,17 @@ RFC2812, 2.2 \"Character codes\" says: list)) (defun riece-format-identity (identity &optional prefix-only) + "Convert IDENTITY object to a string. +If the optional 2nd argument PREFIX-ONLY is non-nil, don't append +server part of the identity. + +The returned string will be abbreviated by +`riece-abbrev-identity-string-function', and `riece-identity' property +will be added." (let ((string (if (or prefix-only (equal (riece-identity-server identity) "")) - (riece-identity-prefix identity) + (copy-sequence (riece-identity-prefix identity)) (concat (riece-identity-prefix identity) " " (riece-identity-server identity))))) (if riece-abbrev-identity-string-function @@ -133,6 +143,9 @@ RFC2812, 2.2 \"Character codes\" says: string)) (defun riece-parse-identity (string) + "Convert STRING to an identity object. +The string will be expanded by +`riece-expand-identity-string-function'." (if riece-expand-identity-string-function (setq string (funcall riece-expand-identity-string-function string))) (riece-make-identity (if (string-match " " string) @@ -143,8 +156,12 @@ RFC2812, 2.2 \"Character codes\" says: ""))) (defun riece-completing-read-identity (prompt channels - &optional predicate must-match - initial) + &optional predicate require-match + initial history default) + "Read an identity object in the minibuffer, with completion. +PROMPT is a string to prompt with; normally it ends in a colon and a space. +CHANNELS is a list of identity objects. +The rest of arguments are the same as `completing-read'." (let* ((string (completing-read prompt @@ -152,7 +169,7 @@ RFC2812, 2.2 \"Character codes\" says: (list (riece-format-identity channel))) (delq nil (copy-sequence (or channels riece-current-channels)))) - predicate must-match initial)) + predicate require-match initial history default)) (identity (riece-parse-identity string))) (unless (string-match (concat "^\\(" riece-channel-regexp "\\|"