Mercurial > emacs
comparison lisp/erc/erc-compat.el @ 68451:fc745b05e928
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-22
Creator: Michael Olson <mwolson@gnu.org>
Install ERC.
author | Miles Bader <miles@gnu.org> |
---|---|
date | Sun, 29 Jan 2006 13:08:58 +0000 |
parents | |
children | bc5d69739d5e |
comparison
equal
deleted
inserted
replaced
68450:a3ba4ef5d590 | 68451:fc745b05e928 |
---|---|
1 ;;; erc-compat.el --- ERC compatibility code for XEmacs | |
2 | |
3 ;; Copyright (C) 2002, 2003, 2005, 2006 Free Software Foundation, Inc. | |
4 | |
5 ;; Author: Alex Schroeder <alex@gnu.org> | |
6 ;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?EmacsIRCClient | |
7 | |
8 ;; This file is part of GNU Emacs. | |
9 | |
10 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
11 ;; it under the terms of the GNU General Public License as published by | |
12 ;; the Free Software Foundation; either version 2, or (at your option) | |
13 ;; any later version. | |
14 | |
15 ;; GNU Emacs is distributed in the hope that it will be useful, | |
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 ;; GNU General Public License for more details. | |
19 | |
20 ;; You should have received a copy of the GNU General Public License | |
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
22 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, | |
23 ;; Boston, MA 02110-1301, USA. | |
24 | |
25 ;;; Commentary: | |
26 | |
27 ;; This mostly defines stuff that cannot be worked around easily. | |
28 | |
29 ;;; Code: | |
30 | |
31 (require 'format-spec) | |
32 | |
33 ;;;###autoload (autoload 'erc-define-minor-mode "erc-compat") | |
34 (defalias 'erc-define-minor-mode 'define-minor-mode) | |
35 (put 'erc-define-minor-mode 'edebug-form-spec 'define-minor-mode) | |
36 | |
37 (defun erc-decode-coding-string (s coding-system) | |
38 "Decode S using CODING-SYSTEM." | |
39 (decode-coding-string s coding-system t)) | |
40 | |
41 (defun erc-encode-coding-string (s coding-system) | |
42 "Encode S using CODING-SYSTEM. | |
43 Return the same string, if the encoding operation is trivial. | |
44 See `erc-encoding-coding-alist'." | |
45 (encode-coding-string s coding-system t)) | |
46 | |
47 (defalias 'erc-propertize 'propertize) | |
48 (defalias 'erc-view-mode-enter 'view-mode-enter) | |
49 (defalias 'erc-function-arglist 'help-function-arglist) | |
50 (defalias 'erc-delete-dups 'delete-dups) | |
51 (defalias 'erc-replace-regexp-in-string 'replace-regexp-in-string) | |
52 | |
53 (defvar erc-emacs-build-time | |
54 (if (stringp emacs-build-time) | |
55 emacs-build-time | |
56 (format-time-string "%Y-%m-%d" emacs-build-time)) | |
57 "Time at which Emacs was dumped out.") | |
58 | |
59 ;; XEmacs' `replace-match' does not replace matching subexpressions in strings. | |
60 (defun erc-replace-match-subexpression-in-string | |
61 (newtext string match subexp start &optional fixedcase literal) | |
62 "Replace the subexpression SUBEXP of the last match in STRING with NEWTEXT. | |
63 MATCH is the text which matched the subexpression (see `match-string'). | |
64 START is the beginning position of the last match (see `match-beginning'). | |
65 See `replace-match' for explanations of FIXEDCASE and LITERAL." | |
66 (cond ((featurep 'xemacs) | |
67 (string-match match string start) | |
68 (replace-match newtext fixedcase literal string)) | |
69 (t (replace-match newtext fixedcase literal string subexp)))) | |
70 | |
71 (defalias 'erc-cancel-timer 'cancel-timer) | |
72 (defalias 'erc-make-obsolete 'make-obsolete) | |
73 (defalias 'erc-make-obsolete-variable 'make-obsolete-variable) | |
74 | |
75 ;; Provde an equivalent of `assert', based on the code from cl-macs.el | |
76 (defun erc-const-expr-p (x) | |
77 (cond ((consp x) | |
78 (or (eq (car x) 'quote) | |
79 (and (memq (car x) '(function function*)) | |
80 (or (symbolp (nth 1 x)) | |
81 (and (eq (and (consp (nth 1 x)) | |
82 (car (nth 1 x))) 'lambda) 'func))))) | |
83 ((symbolp x) (and (memq x '(nil t)) t)) | |
84 (t t))) | |
85 | |
86 (put 'erc-assertion-failed 'error-conditions '(error)) | |
87 (put 'erc-assertion-failed 'error-message "Assertion failed") | |
88 | |
89 (defun erc-list* (arg &rest rest) | |
90 "Return a new list with specified args as elements, cons'd to last arg. | |
91 Thus, `(list* A B C D)' is equivalent to `(nconc (list A B C) D)', or to | |
92 `(cons A (cons B (cons C D)))'." | |
93 (cond ((not rest) arg) | |
94 ((not (cdr rest)) (cons arg (car rest))) | |
95 (t (let* ((n (length rest)) | |
96 (copy (copy-sequence rest)) | |
97 (last (nthcdr (- n 2) copy))) | |
98 (setcdr last (car (cdr last))) | |
99 (cons arg copy))))) | |
100 | |
101 (defmacro erc-assert (form &optional show-args string &rest args) | |
102 "Verify that FORM returns non-nil; signal an error if not. | |
103 Second arg SHOW-ARGS means to include arguments of FORM in message. | |
104 Other args STRING and ARGS... are arguments to be passed to `error'. | |
105 They are not evaluated unless the assertion fails. If STRING is | |
106 omitted, a default message listing FORM itself is used." | |
107 (let ((sargs | |
108 (and show-args | |
109 (delq nil (mapcar | |
110 (function | |
111 (lambda (x) | |
112 (and (not (erc-const-expr-p x)) x))) | |
113 (cdr form)))))) | |
114 (list 'progn | |
115 (list 'or form | |
116 (if string | |
117 (erc-list* 'error string (append sargs args)) | |
118 (list 'signal '(quote erc-assertion-failed) | |
119 (erc-list* 'list (list 'quote form) sargs)))) | |
120 nil))) | |
121 | |
122 ;; Provide a simpler replacement for `member-if' | |
123 (defun erc-member-if (predicate list) | |
124 "Find the first item satisfying PREDICATE in LIST. | |
125 Return the sublist of LIST whose car matches." | |
126 (let ((ptr list)) | |
127 (catch 'found | |
128 (while ptr | |
129 (when (funcall predicate (car ptr)) | |
130 (throw 'found ptr)) | |
131 (setq ptr (cdr ptr)))))) | |
132 | |
133 ;; Provide a simpler replacement for `delete-if' | |
134 (defun erc-delete-if (predicate seq) | |
135 "Remove all items satisfying PREDICATE in SEQ. | |
136 This is a destructive function: it reuses the storage of SEQ | |
137 whenever possible." | |
138 ;; remove from car | |
139 (while (when (funcall predicate (car seq)) | |
140 (setq seq (cdr seq)))) | |
141 ;; remove from cdr | |
142 (let ((ptr seq) | |
143 (next (cdr seq))) | |
144 (while next | |
145 (when (funcall predicate (car next)) | |
146 (setcdr ptr (if (consp next) | |
147 (cdr next) | |
148 nil))) | |
149 (setq ptr (cdr ptr)) | |
150 (setq next (cdr ptr)))) | |
151 seq) | |
152 | |
153 ;; Provide a simpler replacement for `remove-if-not' | |
154 (defun erc-remove-if-not (predicate seq) | |
155 "Remove all items not satisfying PREDICATE in SEQ. | |
156 This is a non-destructive function; it makes a copy of SEQ to | |
157 avoid corrupting the original SEQ." | |
158 (let (newseq) | |
159 (dolist (el seq) | |
160 (when (funcall predicate el) | |
161 (setq newseq (cons el newseq)))) | |
162 (nreverse newseq))) | |
163 | |
164 ;; Provide a simpler replacement for `gensym'. | |
165 (defvar *erc-sym-counter* 0) | |
166 (defun erc-gensym () | |
167 "Generate a new uninterned symbol." | |
168 (let ((num (prog1 *erc-sym-counter* | |
169 (setq *erc-sym-counter* (1+ *erc-sym-counter*))))) | |
170 (make-symbol (format "*erc-sym-%d*" num)))) | |
171 | |
172 ;; Copied from cl-extra.el | |
173 (defun erc-subseq (seq start &optional end) | |
174 "Return the subsequence of SEQ from START to END. | |
175 If END is omitted, it defaults to the length of the sequence. | |
176 If START or END is negative, it counts from the end." | |
177 (if (stringp seq) (substring seq start end) | |
178 (let (len) | |
179 (and end (< end 0) (setq end (+ end (setq len (length seq))))) | |
180 (if (< start 0) (setq start (+ start (or len (setq len (length seq)))))) | |
181 (cond ((listp seq) | |
182 (if (> start 0) (setq seq (nthcdr start seq))) | |
183 (if end | |
184 (let ((res nil)) | |
185 (while (>= (setq end (1- end)) start) | |
186 (push (pop seq) res)) | |
187 (nreverse res)) | |
188 (copy-sequence seq))) | |
189 (t | |
190 (or end (setq end (or len (length seq)))) | |
191 (let ((res (make-vector (max (- end start) 0) nil)) | |
192 (i 0)) | |
193 (while (< start end) | |
194 (aset res i (aref seq start)) | |
195 (setq i (1+ i) start (1+ start))) | |
196 res)))))) | |
197 | |
198 (provide 'erc-compat) | |
199 | |
200 ;;; erc-compat.el ends here | |
201 ;; | |
202 ;; Local Variables: | |
203 ;; indent-tabs-mode: t | |
204 ;; tab-width: 8 | |
205 ;; End: | |
206 | |
207 ;; arch-tag: 8948ffe0-aff8-4ad8-a196-368ebbfd58ff |