| 1 | ;;; erc-compat.el --- ERC compatibility code for XEmacs |
| 2 | |
| 3 | ;; Copyright (C) 2002-2003, 2005-2011 Free Software Foundation, Inc. |
| 4 | |
| 5 | ;; Author: Alex Schroeder <alex@gnu.org> |
| 6 | ;; URL: http://www.emacswiki.org/cgi-bin/wiki/ERC |
| 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 3 of the License, or |
| 13 | ;; (at your option) 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. If not, see <http://www.gnu.org/licenses/>. |
| 22 | |
| 23 | ;;; Commentary: |
| 24 | |
| 25 | ;; This mostly defines stuff that cannot be worked around easily. |
| 26 | |
| 27 | ;;; Code: |
| 28 | |
| 29 | (require 'format-spec) |
| 30 | |
| 31 | ;;;###autoload (autoload 'erc-define-minor-mode "erc-compat") |
| 32 | (defalias 'erc-define-minor-mode 'define-minor-mode) |
| 33 | (put 'erc-define-minor-mode 'edebug-form-spec 'define-minor-mode) |
| 34 | |
| 35 | (defun erc-decode-coding-string (s coding-system) |
| 36 | "Decode S using CODING-SYSTEM." |
| 37 | (decode-coding-string s coding-system t)) |
| 38 | |
| 39 | (defun erc-encode-coding-string (s coding-system) |
| 40 | "Encode S using CODING-SYSTEM. |
| 41 | Return the same string, if the encoding operation is trivial. |
| 42 | See `erc-encoding-coding-alist'." |
| 43 | (encode-coding-string s coding-system t)) |
| 44 | |
| 45 | (defalias 'erc-propertize 'propertize) |
| 46 | (defalias 'erc-view-mode-enter 'view-mode-enter) |
| 47 | (autoload 'help-function-arglist "help-fns") |
| 48 | (defalias 'erc-function-arglist 'help-function-arglist) |
| 49 | (defalias 'erc-delete-dups 'delete-dups) |
| 50 | (defalias 'erc-replace-regexp-in-string 'replace-regexp-in-string) |
| 51 | |
| 52 | (defun erc-set-write-file-functions (new-val) |
| 53 | (set (make-local-variable 'write-file-functions) new-val)) |
| 54 | |
| 55 | (defvar erc-emacs-build-time |
| 56 | (if (stringp emacs-build-time) |
| 57 | emacs-build-time |
| 58 | (format-time-string "%Y-%m-%d" emacs-build-time)) |
| 59 | "Time at which Emacs was dumped out.") |
| 60 | |
| 61 | ;; Emacs 21 and XEmacs do not have user-emacs-directory, but XEmacs |
| 62 | ;; has user-init-directory. |
| 63 | (defvar erc-user-emacs-directory |
| 64 | (cond ((boundp 'user-emacs-directory) |
| 65 | user-emacs-directory) |
| 66 | ((boundp 'user-init-directory) |
| 67 | user-init-directory) |
| 68 | (t "~/.emacs.d/")) |
| 69 | "Directory beneath which additional per-user Emacs-specific files |
| 70 | are placed. |
| 71 | Note that this should end with a directory separator.") |
| 72 | |
| 73 | ;; XEmacs' `replace-match' does not replace matching subexpressions in strings. |
| 74 | (defun erc-replace-match-subexpression-in-string |
| 75 | (newtext string match subexp start &optional fixedcase literal) |
| 76 | "Replace the subexpression SUBEXP of the last match in STRING with NEWTEXT. |
| 77 | MATCH is the text which matched the subexpression (see `match-string'). |
| 78 | START is the beginning position of the last match (see `match-beginning'). |
| 79 | See `replace-match' for explanations of FIXEDCASE and LITERAL." |
| 80 | (cond ((featurep 'xemacs) |
| 81 | (string-match match string start) |
| 82 | (replace-match newtext fixedcase literal string)) |
| 83 | (t (replace-match newtext fixedcase literal string subexp)))) |
| 84 | |
| 85 | (defalias 'erc-with-selected-window 'with-selected-window) |
| 86 | (defalias 'erc-cancel-timer 'cancel-timer) |
| 87 | (defalias 'erc-make-obsolete 'make-obsolete) |
| 88 | (defalias 'erc-make-obsolete-variable 'make-obsolete-variable) |
| 89 | |
| 90 | ;; Provide a simpler replacement for `member-if' |
| 91 | (defun erc-member-if (predicate list) |
| 92 | "Find the first item satisfying PREDICATE in LIST. |
| 93 | Return the sublist of LIST whose car matches." |
| 94 | (let ((ptr list)) |
| 95 | (catch 'found |
| 96 | (while ptr |
| 97 | (when (funcall predicate (car ptr)) |
| 98 | (throw 'found ptr)) |
| 99 | (setq ptr (cdr ptr)))))) |
| 100 | |
| 101 | ;; Provide a simpler replacement for `delete-if' |
| 102 | (defun erc-delete-if (predicate seq) |
| 103 | "Remove all items satisfying PREDICATE in SEQ. |
| 104 | This is a destructive function: it reuses the storage of SEQ |
| 105 | whenever possible." |
| 106 | ;; remove from car |
| 107 | (while (when (funcall predicate (car seq)) |
| 108 | (setq seq (cdr seq)))) |
| 109 | ;; remove from cdr |
| 110 | (let ((ptr seq) |
| 111 | (next (cdr seq))) |
| 112 | (while next |
| 113 | (when (funcall predicate (car next)) |
| 114 | (setcdr ptr (if (consp next) |
| 115 | (cdr next) |
| 116 | nil))) |
| 117 | (setq ptr (cdr ptr)) |
| 118 | (setq next (cdr ptr)))) |
| 119 | seq) |
| 120 | |
| 121 | ;; Provide a simpler replacement for `remove-if-not' |
| 122 | (defun erc-remove-if-not (predicate seq) |
| 123 | "Remove all items not satisfying PREDICATE in SEQ. |
| 124 | This is a non-destructive function; it makes a copy of SEQ to |
| 125 | avoid corrupting the original SEQ." |
| 126 | (let (newseq) |
| 127 | (dolist (el seq) |
| 128 | (when (funcall predicate el) |
| 129 | (setq newseq (cons el newseq)))) |
| 130 | (nreverse newseq))) |
| 131 | |
| 132 | ;; Copied from cl-extra.el |
| 133 | (defun erc-subseq (seq start &optional end) |
| 134 | "Return the subsequence of SEQ from START to END. |
| 135 | If END is omitted, it defaults to the length of the sequence. |
| 136 | If START or END is negative, it counts from the end." |
| 137 | (if (stringp seq) (substring seq start end) |
| 138 | (let (len) |
| 139 | (and end (< end 0) (setq end (+ end (setq len (length seq))))) |
| 140 | (if (< start 0) (setq start (+ start (or len (setq len (length seq)))))) |
| 141 | (cond ((listp seq) |
| 142 | (if (> start 0) (setq seq (nthcdr start seq))) |
| 143 | (if end |
| 144 | (let ((res nil)) |
| 145 | (while (>= (setq end (1- end)) start) |
| 146 | (push (pop seq) res)) |
| 147 | (nreverse res)) |
| 148 | (copy-sequence seq))) |
| 149 | (t |
| 150 | (or end (setq end (or len (length seq)))) |
| 151 | (let ((res (make-vector (max (- end start) 0) nil)) |
| 152 | (i 0)) |
| 153 | (while (< start end) |
| 154 | (aset res i (aref seq start)) |
| 155 | (setq i (1+ i) start (1+ start))) |
| 156 | res)))))) |
| 157 | |
| 158 | (provide 'erc-compat) |
| 159 | |
| 160 | ;;; erc-compat.el ends here |
| 161 | ;; |
| 162 | ;; Local Variables: |
| 163 | ;; indent-tabs-mode: t |
| 164 | ;; tab-width: 8 |
| 165 | ;; End: |
| 166 | |