;;; erc-compat.el --- ERC compatibility code for XEmacs;; Copyright (C) 2002, 2003, 2005, 2006 Free Software Foundation, Inc.;; Author: Alex Schroeder <alex@gnu.org>;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?EmacsIRCClient;; This file is part of GNU Emacs.;; GNU Emacs 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.;; GNU Emacs 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., 51 Franklin Street, Fifth Floor,;; Boston, MA 02110-1301, USA.;;; Commentary:;; This mostly defines stuff that cannot be worked around easily.;;; Code:(defconsterc-compat-version"$Revision$""ERC compat revision.");; erc-define-minor-mode: the easy-mmode-define-minor-mode available;; in XEmacs' easy-mmode.el does not have the BODY argument. This;; code has to work, even if somebody has defaliased;; easy-mmode-define-minor-mode to define-minor-mode. The code runs a;; test first, and if define-minor-mode works, it uninterns all the;; symbols created, so nothing should be left behind.;;;###autoload (autoload 'erc-define-minor-mode "erc-compat")(condition-casenil(progn(define-minor-modeerc-compat-test"Testing `define-minor-mode'."nilnilnil(ignore))(mapc'unintern(apropos-internal"^erc-compat-test"))(defalias'erc-define-minor-mode'define-minor-mode)(put'erc-define-minor-mode'edebug-form-spec'define-minor-mode))(error(defmacroerc-define-minor-mode(modedoc&optionalinit-valuelighterkeymap&restbody)"Define a minor mode like in Emacs.";; Deal with at least /some/ keywords.;; the rest don't seem to be as important.(let(keywglobalpgroup)(while(keywordp(setqkeyw(carbody)))(setqbody(cdrbody))(casekeyw(:global(setqglobalp(popbody)))(:group(setqgroup(popbody)))(t(popbody))))`(progn(if,group(defcustom,mode,init-value"Non-nil if the corresponding mode is enabled.":group,group:type'boolean)(defvar,mode,init-value"Non-nil if the corresponding mode is enabled."))(unless,globalp(make-variable-buffer-local',mode))(defun,mode(&optionalarg),doc(interactive)(setq,mode(ifarg(>(prefix-numeric-valuearg)0)(not,mode))),@body,mode)(add-minor-mode,mode,lighter,keymap))))(put'erc-define-minor-mode'edebug-form-spec'(&definenamestringp[&optionalsexpsexp&orconspsymbolp][&rest[keywordpsexp]]def-body))));; MULE: decode-coding-string and encode-coding-string -- note that;; XEmacs' functions do not have the NOCOPY argument.;; latin-1 is only available as iso-8859-1 on XEmacs. Since that;; works for both, we will use that.(condition-casenil;; Try 3 arguments(progn(decode-coding-string"a"'iso-8859-1t)(defunerc-decode-coding-string(scoding-system)"Decode S using CODING-SYSTEM."(decode-coding-stringscoding-systemt)))(error(condition-casenil;; Try 2 arguments(progn(decode-coding-string"a"'iso-8859-1)(defunerc-decode-coding-string(scoding-system)"Decode S using CODING-SYSTEM."(decode-coding-stringscoding-system)))(error;; Default(defunerc-decode-coding-string(s&restignore)"Return S."s)))))(condition-casenil;; Try 3 arguments(progn(encode-coding-string"a"'iso-8859-1t)(defunerc-encode-coding-string(scoding-system)"Encode S using CODING-SYSTEM.Return the same string, if the encoding operation is trivial.See `erc-encoding-coding-alist'."(encode-coding-stringscoding-systemt)))(error(condition-casenil;; Try 2 arguments(progn(encode-coding-string"a"'iso-8859-1)(defunerc-encode-coding-string(scoding-system)"Encode S using CODING-SYSTEM.See `erc-encoding-coding-alist'."(encode-coding-stringscoding-system)))(error;; Default(defunerc-encode-coding-string(s&restignore)"Return S unchanged."s)))))(if(not(fboundp'propertize))(defunerc-propertize(string&restprops)(let((string(copy-sequencestring)))(whileprops(put-text-property0(lengthstring)(nth0props)(nth1props)string)(setqprops(cddrprops)))string))(defalias'erc-propertize'propertize));;; XEmacs does not have `view-mode-enter', but its `view-mode' has a;;; similar argument list. And we need this in erc-match.el.;; Emacs view-mode-enter: (view-mode-enter &optional RETURN-TO;; EXIT-ACTION);; XEmacs view-mode: (view-mode &optional PREV-BUFFER EXIT-ACTION;; CLEAN-BS);; But note Emacs view-mode: (view-mode &optional ARG)(defalias'erc-view-mode-enter(if(and(fboundp'view-mode)(not(fboundp'view-mode-enter)))'view-mode'view-mode-enter));; if we're in emacs21 CVS, we use help-function-arglist which is more;; sophisticated and can handle subrs, etc(if(fboundp'help-function-arglist)(defalias'erc-function-arglist'help-function-arglist)(defunerc-function-arglist(fun)"Returns the arglist signature of FUN"(let((def(symbol-functionfun)))(ignore-errors;; load an autoloaded function first(when(equal'autoload(car-safedef))(load(seconddef))(setqdef(symbol-functionfun)))(if(listpdef)(seconddef)(format"[Arglist not available, try %s instead]"(substitute-command-keys"\\[describe-function]")))))));; XEmacs doesn't have `delete-dups'. Taken from subr.el.(if(fboundp'delete-dups)(defalias'erc-delete-dups'delete-dups)(defunerc-delete-dups(list)"Destructively remove `equal' duplicates from LIST.Store the result in LIST and return it. LIST must be a proper list.Of several `equal' occurrences of an element in LIST, the firstone is kept."(let((taillist))(whiletail(setcdrtail(delete(cartail)(cdrtail)))(setqtail(cdrtail))))list));;; XEmacs has `replace-in-string', Emacs has `replace-regexp-in-string':(cond((fboundp'replace-regexp-in-string)(defalias'erc-replace-regexp-in-string'replace-regexp-in-string))((fboundp'replace-in-string)(defunerc-replace-regexp-in-string(regexprepstring&optionalfixedcaseliteral)(replace-in-stringstringregexprepliteral))));;; Done!;; XEmacs has a string representation of the build time. It's;; possible for date-to-time to throw an "invalid date" error, so;; we'll just use a string instead of a time.(defvarerc-emacs-build-time(if(stringpemacs-build-time)emacs-build-time(format-time-string"%Y-%m-%d"emacs-build-time))"Time at which Emacs was dumped out.");; XEmacs' `replace-match' does not replace matching subexpressions in strings.(defunerc-replace-match-subexpression-in-string(newtextstringmatchsubexpstart&optionalfixedcaseliteral)"Replace the subexpression SUBEXP of the last match in STRING with NEWTEXT.MATCH is the text which matched the subexpression (see `match-string').START is the beginning position of the last match (see `match-beginning').See `replace-match' for explanations of FIXEDCASE and LITERAL."(cond((featurep'xemacs)(string-matchmatchstringstart)(replace-matchnewtextfixedcaseliteralstring))(t(replace-matchnewtextfixedcaseliteralstringsubexp))));; If a version of Emacs or XEmacs does not have gnus or tramp, they;; will not have the format-spec library. We deal with this by;; providing copies of its functions if the library is not available.(condition-casenil(require'format-spec)(error(defunformat-spec(formatspecification)"Return a string based on FORMAT and SPECIFICATION.FORMAT is a string containing `format'-like specs like \"bash %u %k\",while SPECIFICATION is an alist mapping from format spec charactersto values."(with-temp-buffer(insertformat)(goto-char(point-min))(while(search-forward"%"nilt)(cond;; Quoted percent sign.((eq(char-after)?%)(delete-char1));; Valid format spec.((looking-at"\\([-0-9.]*\\)\\([a-zA-Z]\\)")(let*((num(match-string1))(spec(string-to-char(match-string2)))(val(cdr(assqspecspecification))))(delete-region(1-(match-beginning0))(match-end0))(unlessval(error"Invalid format character: %s"spec))(insert(format(concat"%"num"s")val))));; Signal an error on bogus format strings.(t(error"Invalid format string"))))(buffer-string)))(defunformat-spec-make(&restpairs)"Return an alist suitable for use in `format-spec' based on PAIRS.PAIRS is a list where every other element is a character and a value,starting with a character."(let(alist)(whilepairs(unless(cdrpairs)(error"Invalid list of pairs"))(push(cons(carpairs)(cadrpairs))alist)(setqpairs(cddrpairs)))(nreversealist)))));; Emacs has `cancel-timer', but XEmacs uses `delete-itimer'.(defunerc-cancel-timer(timer)(cond((fboundp'cancel-timer)(cancel-timertimer))((fboundp'delete-itimer)(delete-itimertimer))(t(error"Cannot find `cancel-timer' variant"))));; Emacs accepts three arguments to `make-obsolete', `make-obsolete-variable';; XEmacs only takes two arguments(defunerc-make-obsolete(old-namenew-namewhen)"Make the byte-compiler warn that OLD-NAME is obsolete.The warning will say that NEW-NAME should be used instead.WHEN should be a string indicating when the function wasfirst made obsolete, either the file's revision number or anERC release version number."(condition-casenil(make-obsoleteold-namenew-namewhen)(wrong-number-of-arguments(make-obsoleteold-namenew-name))))(defunerc-make-obsolete-variable(old-namenew-namewhen)"Make the byte-compiler warn that OLD-NAME is obsolete.The warning will say that NEW-NAME should be used instead.WHEN should be a string indicating when the variable wasfirst made obsolete, either the file's revision number or anERC release version number."(condition-casenil(make-obsolete-variableold-namenew-namewhen)(wrong-number-of-arguments(make-obsolete-variableold-namenew-name))));; Provde an equivalent of `assert', based on the code from cl-macs.el(defunerc-const-expr-p(x)(cond((conspx)(or(eq(carx)'quote)(and(memq(carx)'(functionfunction*))(or(symbolp(nth1x))(and(eq(and(consp(nth1x))(car(nth1x)))'lambda)'func)))))((symbolpx)(and(memqx'(nilt))t))(tt)))(put'erc-assertion-failed'error-conditions'(error))(put'erc-assertion-failed'error-message"Assertion failed")(defunerc-list*(arg&restrest)"Return a new list with specified args as elements, cons'd to last arg.Thus, `(list* A B C D)' is equivalent to `(nconc (list A B C) D)', or to`(cons A (cons B (cons C D)))'."(cond((notrest)arg)((not(cdrrest))(consarg(carrest)))(t(let*((n(lengthrest))(copy(copy-sequencerest))(last(nthcdr(-n2)copy)))(setcdrlast(car(cdrlast)))(consargcopy)))))(defmacroerc-assert(form&optionalshow-argsstring&restargs)"Verify that FORM returns non-nil; signal an error if not.Second arg SHOW-ARGS means to include arguments of FORM in message.Other args STRING and ARGS... are arguments to be passed to `error'.They are not evaluated unless the assertion fails. If STRING isomitted, a default message listing FORM itself is used."(let((sargs(andshow-args(delqnil(mapcar(function(lambda(x)(and(not(erc-const-expr-px))x)))(cdrform))))))(list'progn(list'orform(ifstring(erc-list*'errorstring(appendsargsargs))(list'signal'(quoteerc-assertion-failed)(erc-list*'list(list'quoteform)sargs))))nil)));; Provide a simpler replacement for `member-if'(defunerc-member-if(predicatelist)"Find the first item satisfying PREDICATE in LIST.Return the sublist of LIST whose car matches."(let((ptrlist))(catch'found(whileptr(when(funcallpredicate(carptr))(throw'foundptr))(setqptr(cdrptr))))));; Provide a simpler replacement for `delete-if'(defunerc-delete-if(predicateseq)"Remove all items satisfying PREDICATE in SEQ.This is a destructive function: it reuses the storage of SEQwhenever possible.";; remove from car(while(when(funcallpredicate(carseq))(setqseq(cdrseq))));; remove from cdr(let((ptrseq)(next(cdrseq)))(whilenext(when(funcallpredicate(carnext))(setcdrptr(if(conspnext)(cdrnext)nil)))(setqptr(cdrptr))(setqnext(cdrptr))))seq);; Provide a simpler replacement for `remove-if-not'(defunerc-remove-if-not(predicateseq)"Remove all items not satisfying PREDICATE in SEQ.This is a non-destructive function; it makes a copy of SEQ toavoid corrupting the original SEQ."(let(newseq)(dolist(elseq)(when(funcallpredicateel)(setqnewseq(conselnewseq))))(nreversenewseq)));; Provide a simpler replacement for `gensym'.(defvar*erc-sym-counter*0)(defunerc-gensym()"Generate a new uninterned symbol."(let((num(prog1*erc-sym-counter*(setq*erc-sym-counter*(1+*erc-sym-counter*)))))(make-symbol(format"*erc-sym-%d*"num))));; Copied from cl-extra.el(defunerc-subseq(seqstart&optionalend)"Return the subsequence of SEQ from START to END.If END is omitted, it defaults to the length of the sequence.If START or END is negative, it counts from the end."(if(stringpseq)(substringseqstartend)(let(len)(andend(<end0)(setqend(+end(setqlen(lengthseq)))))(if(<start0)(setqstart(+start(orlen(setqlen(lengthseq))))))(cond((listpseq)(if(>start0)(setqseq(nthcdrstartseq)))(ifend(let((resnil))(while(>=(setqend(1-end))start)(push(popseq)res))(nreverseres))(copy-sequenceseq)))(t(orend(setqend(orlen(lengthseq))))(let((res(make-vector(max(-endstart)0)nil))(i0))(while(<startend)(asetresi(arefseqstart))(setqi(1+i)start(1+start)))res))))))(provide'erc-compat);;; erc-compat.el ends here;;;; Local Variables:;; indent-tabs-mode: t;; tab-width: 8;; End:;; arch-tag: 8948ffe0-aff8-4ad8-a196-368ebbfd58ff