/[guile]/guile/guile-core/lang/elisp/internals/fset.scm
ViewVC logotype

Diff of /guile/guile-core/lang/elisp/internals/fset.scm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by ossau, Fri Oct 26 16:42:43 2001 UTC revision 1.2 by ossau, Tue Jan 22 23:46:01 2002 UTC
# Line 0  Line 1 
1    (define-module (lang elisp internals fset)
2      #:use-module (lang elisp internals signal)
3      #:use-module (lang elisp internals evaluation)
4      #:export (fset
5                fref
6                fref/error-if-void
7                elisp-apply
8                interactive-specification
9                not-subr?
10                elisp-export-module))
11    
12    (define the-variables-module (resolve-module '(lang elisp variables)))
13    
14    ;; By default, Guile GC's unreachable symbols.  So we need to make
15    ;; sure they stay reachable!
16    (define syms '())
17    
18    ;; elisp-export-module, if non-#f, holds a module to which definitions
19    ;; should be exported under their normal symbol names.  This is used
20    ;; when importing Elisp definitions into Scheme.
21    (define elisp-export-module (make-fluid))
22    
23    ;; Store the procedure, macro or alias symbol PROC in SYM's function
24    ;; slot.
25    (define (fset sym proc)
26      (or (memq sym syms)
27          (set! syms (cons sym syms)))
28      (let ((vcell (symbol-fref sym))
29            (vsym #f)
30            (export-module (fluid-ref elisp-export-module)))
31        ;; Playing around with variables and name properties...  For the
32        ;; reasoning behind this, see the commentary in (lang elisp
33        ;; variables).
34        (cond ((procedure? proc)
35               ;; A procedure created from Elisp will already have a name
36               ;; property attached, with value of the form
37               ;; <elisp-defun:NAME> or <elisp-lambda>.  Any other
38               ;; procedure coming through here must be an Elisp primitive
39               ;; definition, so we give it a name of the form
40               ;; <elisp-subr:NAME>.
41               (or (procedure-name proc)
42                   (set-procedure-property! proc
43                                            'name
44                                            (symbol-append '<elisp-subr: sym '>)))
45               (set! vsym (procedure-name proc)))
46              ((macro? proc)
47               ;; Macros coming through here must be defmacros, as all
48               ;; primitive special forms are handled directly by the
49               ;; transformer.
50               (set-procedure-property! (macro-transformer proc)
51                                        'name
52                                        (symbol-append '<elisp-defmacro: sym '>))
53               (set! vsym (procedure-name (macro-transformer proc))))
54              (else
55               ;; An alias symbol.
56               (set! vsym (symbol-append '<elisp-defalias: sym '>))))
57        ;; This is the important bit!
58        (if (variable? vcell)
59            (variable-set! vcell proc)
60            (begin
61              (set! vcell (make-variable proc))
62              (symbol-fset! sym vcell)
63              ;; Playing with names and variables again - see above.
64              (module-add! the-variables-module vsym vcell)
65              (module-export! the-variables-module (list vsym))))
66        ;; Export variable to the export module, if non-#f.
67        (if (and export-module
68                 (or (procedure? proc)
69                     (macro? proc)))
70            (begin
71              (module-add! export-module sym vcell)
72              (module-export! export-module (list sym))))))
73    
74    ;; Retrieve the procedure or macro stored in SYM's function slot.
75    ;; Note the asymmetry w.r.t. fset: if fref finds an alias symbol, it
76    ;; recursively calls fref on that symbol.  Returns #f if SYM's
77    ;; function slot doesn't contain a valid definition.
78    (define (fref sym)
79      (let ((var (symbol-fref sym)))
80        (if (and var (variable? var))
81            (let ((proc (variable-ref var)))
82              (cond ((symbol? proc)
83                     (fref proc))
84                    (else
85                     proc)))
86            #f)))
87    
88    ;; Same as fref, but signals an Elisp error if SYM's function
89    ;; definition is void.
90    (define (fref/error-if-void sym)
91      (or (fref sym)
92          (signal 'void-function (list sym))))
93    
94    ;; Maps a procedure to its (interactive ...) spec.
95    (define interactive-specification (make-object-property))
96    
97    ;; Maps a procedure to #t if it is NOT a built-in.
98    (define not-subr? (make-object-property))
99    
100    (define (elisp-apply function . args)
101      (apply apply
102             (cond ((symbol? function)
103                    (fref/error-if-void function))
104                   ((procedure? function)
105                    function)
106                   ((and (pair? function)
107                         (eq? (car function) 'lambda))
108                    (eval function the-elisp-module))
109                   (else
110                    (signal 'invalid-function (list function))))
111             args))

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26