|
4
|
1 ;;; cless.el --- Common lisp and Emacs Lisp source sharing
|
|
|
2
|
|
|
3 ;; Copyright (C) 1996 MORIOKA Tomohiko
|
|
|
4
|
|
|
5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
|
|
|
6 ;; Version:
|
|
10
|
7 ;; $Id: cless.el,v 1.3 1996/12/29 00:15:08 steve Exp $
|
|
4
|
8 ;; Keywords: common lisp
|
|
|
9
|
|
|
10 ;; This file is not part of GNU Emacs.
|
|
|
11
|
|
|
12 ;; This program is free software; you can redistribute it and/or
|
|
|
13 ;; modify it under the terms of the GNU General Public License as
|
|
|
14 ;; published by the Free Software Foundation; either version 2, or (at
|
|
|
15 ;; your option) any later version.
|
|
|
16
|
|
|
17 ;; This program is distributed in the hope that it will be useful, but
|
|
|
18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
|
20 ;; General Public License for more details.
|
|
|
21
|
|
|
22 ;; You should have received a copy of the GNU General Public License
|
|
|
23 ;; along with This program; see the file COPYING. If not, write to
|
|
|
24 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
|
25 ;; Boston, MA 02111-1307, USA.
|
|
|
26
|
|
|
27 ;;; Code:
|
|
|
28
|
|
|
29 (require 'cl)
|
|
|
30
|
|
|
31 (defun call-after-loaded (module func &optional hook-name)
|
|
|
32 "If MODULE is provided, then FUNC is called.
|
|
|
33 Otherwise func is set to MODULE-load-hook.
|
|
|
34 If optional argument HOOK-NAME is specified,
|
|
|
35 it is used as hook to set. [cless.el; imported from tl-misc.el]"
|
|
|
36 (if (featurep module)
|
|
|
37 (funcall func)
|
|
|
38 (progn
|
|
|
39 (if (null hook-name)
|
|
|
40 (setq hook-name
|
|
|
41 (intern (concat (symbol-name module) "-load-hook")))
|
|
|
42 )
|
|
|
43 (add-hook hook-name func)
|
|
|
44 )))
|
|
|
45
|
|
|
46 (defun define-cless-alias (alias func)
|
|
|
47 (defalias alias func)
|
|
|
48 (call-after-loaded
|
|
|
49 'cl-macs
|
|
|
50 (` (lambda ()
|
|
|
51 (define-compiler-macro (, alias) (&rest args)
|
|
|
52 (cons (, (list 'quote func)) args)
|
|
|
53 ))
|
|
|
54 ))
|
|
|
55 )
|
|
|
56
|
|
|
57 (define-cless-alias 'FLOOR 'floor*)
|
|
|
58 (define-cless-alias 'CEILING 'ceiling*)
|
|
|
59 (define-cless-alias 'TRUNCATE 'truncate*)
|
|
|
60 (define-cless-alias 'ROUND 'round*)
|
|
|
61 (define-cless-alias 'MOD 'mod*)
|
|
|
62
|
|
|
63 (define-cless-alias 'DELETE 'delete*)
|
|
|
64 (define-cless-alias 'SORT 'sort*)
|
|
|
65 (define-cless-alias 'MEMBER 'member*)
|
|
|
66 (define-cless-alias 'ASSOC 'assoc*)
|
|
|
67 (define-cless-alias 'RASSOC 'rassoc*)
|
|
|
68
|
|
|
69 (define-cless-alias 'MAPCAR 'mapcar*)
|
|
|
70
|
|
|
71 (define-cless-alias 'DEFUN 'defun*)
|
|
|
72
|
|
|
73
|
|
|
74
|
|
|
75 ;;; @ end
|
|
|
76 ;;;
|
|
|
77
|
|
|
78 (provide 'cless)
|
|
|
79
|
|
|
80 ;;; cless.el ends here
|
