1 ;;; liece-inlines.el --- Inline macros for various use.
2 ;; Copyright (C) 1998-2000 Daiki Ueno
4 ;; Author: Daiki Ueno <ueno@unixuser.org>
7 ;; Keywords: IRC, liece
9 ;; This file is part of Liece.
11 ;; This program is free software; you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option)
16 ;; This program is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24 ;; Boston, MA 02111-1307, USA.
32 (require 'liece-globals)
33 (require 'liece-compat)
34 (require 'liece-setup)
37 (eval-when-compile (require 'liece-clfns))
39 ;;; @ string functions
41 (defmacro string-times (str n)
42 `(apply #'concat (make-list ,n ,str)))
44 (defmacro string-join (strlst &optional del)
45 `(mapconcat #'identity ,strlst ,del))
47 (static-if (subr-fboundp 'compare-strings)
48 (defmacro string-equal-ignore-case (s1 s2)
49 `(eq t (compare-strings ,s1 0 nil ,s2 0 nil 'ignore-case)))
50 (defmacro string-equal-ignore-case (s1 s2)
51 `(string-equal (upcase ,s1) (upcase ,s2))))
53 (static-if (fboundp 'member-ignore-case)
54 (defalias 'string-list-member-ignore-case
56 (defsubst string-list-member-ignore-case (thing list)
57 "Returns t if thing is member of list, not funcallable"
60 (and (stringp item) (string-equal-ignore-case thing item)))
63 (defsubst string-list-remove-ignore-case (thing list)
64 (let ((element (string-list-member-ignore-case thing list)))
66 (remq (car element) list)
69 (defsubst string-list-delete-ignore-case (thing list)
70 (let ((element (string-list-member-ignore-case thing list)))
72 (delq (car element) list)
75 (defsubst string-list-remove (thing list)
76 (let ((element (member thing list)))
78 (remq (car element) list)
81 (defsubst string-list-delete (thing list)
82 (let ((element (member thing list)))
84 (delq (car element) list)
87 (defsubst string-list-modify-ignore-case (modifiers list)
88 (dolist (modifier modifiers)
91 (if (string-equal-ignore-case (car modifier) (car p))
92 (setcar p (cdr modifier)))
96 (static-if (fboundp 'assoc-ignore-case)
97 (defalias 'string-assoc-ignore-case 'assoc-ignore-case)
98 (defsubst string-assoc-ignore-case (key list)
100 (lambda (item) (string-equal-ignore-case item key))
103 (defsubst regexp-assoc-ignore-case (key list)
104 "Assoc with REGEXP-KEY from LIST."
108 (string-match (concat "^" (upcase key)) "$") (upcase item))
111 (defsubst regexp-rassoc-ignore-case (key list)
112 "Assoc with KEY from LIST, in which keys are regexps."
115 (string-match (concat "^" (upcase key) "$") (upcase item)))
118 (defmacro list-to-alist (list)
119 `(mapcar #'list ,list))
121 (put 'filter-elements 'lisp-indent-function 2)
123 (defmacro filter-elements (element list condition)
124 `(let (result tail ,element)
127 (setq ,element (car tail))
129 (setq result (cons ,element result)))
130 (setq tail (cdr tail)))
134 ;;; @ helper functions
136 (defmacro liece-functionp (form)
137 `(or (and (symbolp ,form) (fboundp ,form))
138 (and (listp ,form) (eq (car ,form) 'lambda))
139 (byte-code-function-p ,form)))
141 (defun liece-eval-form (form)
143 ((and (listp form) (liece-functionp (car form)))
145 ((and (symbolp form) (boundp form))
149 (defun liece-or (&rest elems)
150 "Return non-nil if any of the elements are non-nil."
156 (defun liece-and (&rest elems)
157 "Return non-nil if all of the elements are non-nil."
164 (defun liece-locate-path (subdir &optional filename)
165 (let ((dir (liece-locate-data-directory
166 (downcase (product-name (product-find 'liece-version))))))
167 (when (and dir (file-directory-p dir))
169 (expand-file-name filename (concat dir subdir))
170 (concat dir subdir)))))
172 (defun liece-locate-icon-file (filename)
173 (or liece-icon-directory
174 (setq liece-icon-directory (liece-locate-path "icons")))
175 (expand-file-name filename liece-icon-directory))
177 (defmacro liece-next-line (arg)
180 (if (eobp) (newline)(next-line 1))
183 ;; Borrowed from `edebug.el'.
184 (defvar liece-gensym-index 0
185 "Integer used by `liece-gensym' to produce new names.")
187 (defun liece-gensym (&optional prefix)
188 "Generate a fresh uninterned symbol.
189 There is an optional argument, PREFIX. PREFIX is the
190 string that begins the new name. Most people take just the default,
191 except when debugging needs suggest otherwise."
194 (let ((newsymbol nil)
196 (while (not newsymbol)
197 (setq newname (concat prefix (int-to-string liece-gensym-index))
198 liece-gensym-index (1+ liece-gensym-index))
199 (if (not (intern-soft newname))
200 (setq newsymbol (make-symbol newname))))
203 (provide 'liece-inlines)
205 ;;; liece-inlines.el ends here