;;; liece-inlines.el --- Inline macros for various use.
;; Copyright (C) 1998-2000 Daiki Ueno

;; Author: Daiki Ueno <ueno@unixuser.org>
;; Created: 1998-09-28
;; Revised: 1998-11-25
;; Keywords: IRC, liece

;; This file is part of Liece.

;; This program 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.

;; This program 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., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.


;;; Commentary:
;; 

;;; Code:

(require 'liece-globals)
(require 'liece-compat)
(require 'liece-setup)
(require 'liece-vars)

(eval-when-compile (require 'liece-clfns))

;;; @ string functions
;;;
(defmacro string-times (str n)
  `(apply #'concat (make-list ,n ,str)))

(defmacro string-join (strlst &optional del)
  `(mapconcat #'identity ,strlst ,del))

(defmacro string-equal-ignore-case (s1 s2)
  `(string-equal (upcase ,s1) (upcase ,s2)))

(static-if (fboundp 'member-ignore-case)
    (defalias 'string-list-member-ignore-case
      'member-ignore-case)
  (defsubst string-list-member-ignore-case (thing list)
    "Returns t if thing is member of list, not funcallable"
    (member-if
     (lambda (item)
       (and (stringp item) (string-equal-ignore-case thing item)))
     list)))

(defsubst string-list-remove-ignore-case (thing list)
  (let ((element (string-list-member-ignore-case thing list)))
    (if element
	(remq (car element) list)
      list)))

(defsubst string-list-delete-ignore-case (thing list)
  (let ((element (string-list-member-ignore-case thing list)))
    (if element
	(delq (car element) list)
      list)))

(defsubst string-list-remove (thing list)
  (let ((element (member thing list)))
    (if element
	(remq (car element) list)
      list)))

(defsubst string-list-delete (thing list)
  (let ((element (member thing list)))
    (if element
	(delq (car element) list)
      list)))

(defsubst string-list-modify-ignore-case (modifiers list)
  (dolist (modifier modifiers)
    (let ((p list))
      (while p
	(if (string-equal-ignore-case (car modifier) (car p))
	    (setcar p (cdr modifier)))
	(setq p (cdr p)))))
  list)

(static-if (fboundp 'assoc-ignore-case)
    (defalias 'string-assoc-ignore-case 'assoc-ignore-case)
  (defsubst string-assoc-ignore-case (key list)
    (assoc-if
     (lambda (item) (string-equal-ignore-case item key))
     list)))

(defsubst regexp-assoc-ignore-case (key list)
  "Assoc with REGEXP-KEY from LIST."
  (save-match-data
    (assoc-if
     (lambda (item)
       (string-match (concat "^" (upcase key)) "$") (upcase item))
     list)))

(defsubst regexp-rassoc-ignore-case (key list)
  "Assoc with KEY from LIST, in which keys are regexps."
  (rassoc-if
   (lambda (item)
     (string-match (concat "^" (upcase key) "$") (upcase item)))
   list))

(defmacro list-to-alist (list)
  `(mapcar #'list ,list))

(put 'filter-elements 'lisp-indent-function 2)

(defmacro filter-elements (element list condition)
  `(let (result tail ,element)
     (setq tail ,list)
     (while tail
       (setq ,element (car tail))
       (if ,condition
	   (setq result (cons ,element result)))
       (setq tail (cdr tail)))
     (nreverse result)))


;;; @ helper functions
;;;
(defmacro liece-functionp (form)
  `(or (and (symbolp ,form) (fboundp ,form))
       (and (listp ,form) (eq (car ,form) 'lambda))
       (byte-code-function-p ,form)))

(defun liece-eval-form (form)
  (cond
   ((and (listp form) (liece-functionp (car form)))
    (eval form))
   ((and (symbolp form) (boundp form))
    (symbol-value form))
   (t form)))

(defun liece-or (&rest elems)
  "Return non-nil if any of the elements are non-nil."
  (catch 'found
    (while elems
      (when (pop elems)
        (throw 'found t)))))

(defun liece-and (&rest elems)
  "Return non-nil if all of the elements are non-nil."
  (catch 'found
    (while elems
      (unless (pop elems)
        (throw 'found nil)))
    t))

(defun liece-locate-path (subdir &optional filename)
  (let ((dir (liece-locate-data-directory
	      (downcase (product-name (product-find 'liece-version))))))
    (when (and dir (file-directory-p dir))
      (if filename
	  (expand-file-name filename (concat dir subdir))
	(concat dir subdir)))))

(defun liece-locate-icon-file (filename)
  (or liece-icon-directory
      (setq liece-icon-directory (liece-locate-path "icons")))
  (expand-file-name filename liece-icon-directory))

(defmacro liece-next-line (arg)
  `(let ((i 0))
     (while (< i ,arg)
       (if (eobp) (newline)(next-line 1))
       (setq i (1+ i)))))

;; Borrowed from `edebug.el'.
(defvar liece-gensym-index 0
  "Integer used by `liece-gensym' to produce new names.")

(defun liece-gensym (&optional prefix)
  "Generate a fresh uninterned symbol.
There is an  optional argument, PREFIX.  PREFIX is the
string that begins the new name. Most people take just the default,
except when debugging needs suggest otherwise."
  (if (null prefix)
      (setq prefix "G"))
  (let ((newsymbol nil)
        (newname   ""))
    (while (not newsymbol)
      (setq newname (concat prefix (int-to-string liece-gensym-index))
	    liece-gensym-index (1+ liece-gensym-index))
      (if (not (intern-soft newname))
          (setq newsymbol (make-symbol newname))))
    newsymbol))

(provide 'liece-inlines)

;;; liece-inlines.el ends here
