diff lisp/tl/tl-misc.el @ 4:b82b59fe008d r19-15b3

Import from CVS: tag r19-15b3
author cvs
date Mon, 13 Aug 2007 08:46:56 +0200
parents
children 4b173ad71786
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/tl/tl-misc.el	Mon Aug 13 08:46:56 2007 +0200
@@ -0,0 +1,94 @@
+;;; tl-misc.el --- miscellaneous utility of tl.
+
+;; Copyright (C) 1995,1996 Free Software Foundation, Inc.
+
+;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Version:
+;;	$Id: tl-misc.el,v 1.1.1.1 1996/12/18 03:55:31 steve Exp $
+;; Keywords: load-path, module, structure
+
+;; This file is part of tl (Tiny Library).
+
+;; 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 This program; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(require 'emu)
+(require 'tl-str)
+
+(autoload 'add-path "file-detect")
+(autoload 'get-latest-path "file-detect")
+(autoload 'file-installed-p "file-detect")
+
+
+;;; @ module and hook
+;;;
+
+(defun call-after-loaded (module func &optional hook-name)
+  "If MODULE is provided, then FUNC is called.
+Otherwise func is set to MODULE-load-hook.
+If optional argument HOOK-NAME is specified,
+it is used as hook to set. [tl-misc.el]"
+  (if (featurep module)
+      (funcall func)
+    (progn
+      (if (null hook-name)
+	  (setq hook-name (symbol-concat module "-load-hook"))
+	)
+      (add-hook hook-name func)
+      )))
+
+
+;;; @ structure
+;;;
+
+(defmacro define-structure (name &rest slots)
+  (let ((pred (symbol-concat name '-p)))
+    (cons 'progn
+	  (nconc
+	   (list
+	    (` (defun (, pred) (obj)
+		 (and (vectorp obj)
+		      (eq (elt obj 0) '(, name))
+		      ))
+	       )
+	    (` (defun (, (symbol-concat name '/create)) (, slots)
+		 (, (cons 'vector (cons (list 'quote name) slots)))
+		 )
+	       ))
+	   (let ((i 1))
+	     (mapcar (function
+		      (lambda (slot)
+			(prog1
+			    (` (defun (, (symbol-concat name '/ slot)) (obj)
+				 (if ((, pred) obj)
+				     (elt obj (, i))
+				   ))
+			       )
+			  (setq i (+ i 1))
+			  )
+			)) slots)
+	     )
+	   (list (list 'quote name))
+	   ))))
+
+
+;;; @ end
+;;;
+
+(provide 'tl-misc)
+
+;;; tl-misc.el ends here