;;; pure-generic.el --- Define some generic macros for emacsen

;; Copyright (C) 2000-2001 Project Pure.

;; Author: SHIMADA Mitsunobu <simm@pure.fan.gr.jp>
;; Keywords: PURE, emacsen, generic functions

;; $Id: pure-generic.el,v 1.3 2001/06/04 16:55:32 simm Exp $

;; This file 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 file 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:

;; PURE means "Primitive Universal Relay-chat Environment"

;;; Code:

;; unless, when
(if (fboundp 'unless) nil
  (put 'unless 'lisp-indent-function 'defun)
  (defmacro unless (cond &rest body)
    "If COND yields nil, do BODY, else return nil."
    (cons 'if (cons cond (cons nil body)))))
(unless (fboundp 'when)
  (put 'when 'lisp-indent-function 'defun)
  (defmacro when (cond &rest body)
    "If COND yields non-nil, do BODY, else return nil."
    (cons 'if (cons cond (cons 'progn body)))))

;; eval-when-compile
(unless (fboundp 'eval-when-compile)
  (fset 'eval-when-compile 'progn))

;;
;; Define variables and functions
;;

;; defsubst, defalias
(unless (fboundp 'defsubst)
  (put 'defsubst 'lisp-indent-function 'defun)
  (defmacro defsubst (name arglist &rest body)
    "Define an inline function.  The syntax is just like that of `defun'."
    (cons 'defun (cons name (cons arglist body)))))
(unless (fboundp 'defalias)
  (defmacro defalias (symbol definition)
    "Set SYMBOL's function definition to DEFINITION, and return DEFINITION.
Associates the function with the current load file, if any."
    (fset symbol definition)))

;; defcustom, defgroup, defface
(unless (fboundp 'defcustom)
  (put 'defcustom 'lisp-indent-function 'defun)
  (defmacro defcustom (symbol value doc &rest args)
    "Declare SYMBOL as a customizable variable that defaults to VALUE.
DOC is the variable documentation."
    (list 'defvar symbol value doc)))
(unless (fboundp 'defgroup)
  (put 'defgroup 'lisp-indent-function 'defun)
  (defmacro defgroup (symbol members doc &rest args)
    "Do nothing. This function is for compatibility."
    nil))
(unless (fboundp 'defface)
  (put 'defface 'lisp-indent-function 'defun)
  (defmacro defface (face spec doc &rest args)
    "Do nothing. This function is for compatibility."
    nil))

;;
;; Regular expression search
;;

;; save-match-data
(unless (fboundp 'save-match-data)
  (defmacro save-match-data (&rest body)
    "Execute the BODY forms, restoring the global value of the match data."
    (list 'let '((prev-match-data (match-data)))
	  (list 'unwind-protect
		(cons 'progn body)
		'(store-match-data prev-match-data)))))

;; match-string
(unless (fboundp 'match-string)
  (defvar pure-generic-last-string-match nil)
  (fset 'pure-generic-string-match (symbol-function 'string-match))
  (defmacro string-match (regexp string &optional start)
    "Return index of start of first match for REGEXP in STRING, or nil.
Case is ignored if `case-fold-search' is non-nil in the current buffer.
If third arg START is non-nil, start search at that index in STRING.
For index of first char beyond the match, do (match-end 0).
`match-end' and `match-beginning' also give indices of substrings
matched by parenthesis constructs in the pattern."
    (list 'progn
	  (list 'setq 'pure-generic-last-string-match string)
	  (if start
	      (list 'pure-generic-string-match regexp string start)
	    (list 'pure-generic-string-match regexp string))))
  (defmacro match-string (num &optional string)
    "Return string of text matched by last search.
NUM specifies which parenthesized expression in the last regexp.
 Value is nil if NUMth pair didn't match, or there were less than NUM pairs.
Zero means the entire text matched by the whole regexp or whole string.
STRING should be given if the last search was by `string-match' on STRING."
    (list 'substring (or string 'pure-generic-last-string-match)
	  (list 'match-beginning num) (list 'match-end num))))

;; match-buffer-string (original extension)
(unless (fboundp 'match-buffer-string)
  (defmacro match-buffer-string (num)
    "Return string of text matched by last search.
NUM specifies which parenthesized expression in the last regexp.
 Value is nil if NUMth pair didn't match, or there were less than NUM pairs.
Zero means the entire text matched by the whole regexp or whole string.

This function is like `match-string', but uses after `re-search-forward',
`re-search-backward', `looking-at', and so on."
    (list 'buffer-substring (list 'match-beginning num) (list 'match-end num))))

;;
;; list management
;;

;; member-ignore-case
(unless (fboundp 'member-ignore-case)
  (defun member-ignore-case (elt list)
    "Like `member', but ignores differences in case and text representation.
ELT must be a string.  Upper-case and lower-case letters are treated as equal.
Unibyte strings are converted to multibyte for comparison."
    (while (and list (not (string= (downcase elt) (downcase (car list)))))
      (setq list (cdr list)))
    list))

;; member-regexp (original extension)
(defun member-regexp (elt list)
  "Return non-nil if ELT is an element of LIST.  Comparison done with `string-match'.
The value is actually the tail of LIST whose car is ELT."
  (if (stringp elt)
      (let (item (result list) (case-fold-search t))
	(save-match-data
	  (catch 'found
	    (while result
	      (setq item (car result))
	      (and (stringp item)
		   (string-match item elt)
		   (throw 'found result))
	      (setq result (cdr result))))))))

;; assoc-regexp (original extension)
(defun assoc-regexp (key list)
  "Return non-nil if KEY is `string-match' to the car of an element of LIST.
The value is actually the element of LIST whose car equals KEY."
  (if (stringp key)
      (let (item (result list) (case-fold-search t))
	(save-match-data
	  (catch 'found
	    (while result
	      (setq item (car result))
	      (and (consp item)
		   (stringp (car item))
		   (string-match (car item) key)
		   (throw 'found item))
	      (setq result (cdr result))))))))

;; rassoc-regexp (original extension)
(defun rassoc-regexp (key list)
  "Return non-nil if KEY is `string-match' to the cdr of an element of LIST.
The value is actually the element of LIST whose cdr equals KEY."
  (if (stringp key)
      (let (item (result list) (case-fold-search t))
	(save-match-data
	  (catch 'found
	    (while result
	      (setq item (car result))
	      (and (consp item)
		   (stringp (cdr item))
		   (string-match (cdr item) key)
		   (throw 'found item))
	      (setq result (cdr result))))))))

;; That's all
(provide 'pure-generic)

;;; pure-generic.el ends here