(unparser-state/port state))))))
(name "" read-only true)
(function +unbound+)
+ (value +unbound+) ;global value, or +not-global+
(plist '())
;; For chaining together contents of obarray buckets.
(next '())
;;
;; anyway???
(define-integrable (make-%symbol name)
- (%record %symbol name +unbound+ '() '() false false-procedure '() '()
- '() '() '() '() '() '() '()))
+ (%record %symbol name +unbound+ +unbound+ '() '() false false-procedure
+ '() '() '() '() '() '() '() '() '()))
\f
;;;; Exported definitions
(%%symbol? obj)))
(define +unbound+ "elisp unbound variable tag")
+(define +not-global+ "elisp non-global variable")
-(define-integrable (%make-symbol name)
- (let ((symbol (make-%symbol name)))
- ;; Don't make variable just because there's an Edwin variable with
- ;; the same name. Otherwise, things could get dicey with multiple
- ;; symbols with the same name -- e.g. an abbrev with the same name
- ;; as an editor variable.
- (%make-symbol-global! symbol)
- symbol))
+(define-integrable %make-symbol make-%symbol)
(declare (integrate-operator ->%symbol))
(define (->%symbol obj)
(define (%put! symbol property value)
(let ((symbol (->%symbol symbol)))
- (if (eq? property Qvariable-documentation)
+ (if (and (eq? property Qvariable-documentation)
+ (eq? +not-global+ (%symbol/value symbol)))
((%symbol/set-docstring! symbol) value))
(let loop ((plist (%symbol/plist symbol)))
(cond ((null? plist)
(define-integrable (%set-symbol-command! sym com)
(set-%symbol/command! (->%symbol sym) com))
-(define-integrable (%symbol-bound? symbol)
- ((%symbol/bound? (->%symbol symbol))))
-
-(define-integrable (%set-symbol-unbound! symbol)
- ((%symbol/unbound! (->%symbol symbol))))
-
-(define-integrable (%symbol-value symbol)
- ((%symbol/get-value (->%symbol symbol))))
-
-(define-integrable (%set-symbol-value! symbol value)
- ((%symbol/set-value! (->%symbol symbol)) value))
-
-(define-integrable (%symbol-default symbol)
- ((%symbol/get-default (->%symbol symbol))))
+(declare (integrate-operator %symbol-bound?))
+(define (%symbol-bound? symbol)
+ (if (%%symbol? symbol)
+ (let ((%value (%symbol/value symbol)))
+ (cond ((eq? %value +unbound+) false)
+ ((eq? %value +not-global+) ((%symbol/bound? symbol)))
+ (else true)))
+ ;; Assume it's the empty list.
+ true))
+
+(declare (integrate-operator %set-symbol-unbound!))
+(define (%set-symbol-unbound! symbol)
+ (if (%%symbol? symbol)
+ (if (eq? symbol Qt)
+ (error:%signal Qsetting-constant (list Qt))
+ (let ((%value (%symbol/value symbol)))
+ (cond ((eq? %value +not-global+)
+ ((%symbol/unbound! symbol)))
+ (else (set-%symbol/value! symbol +unbound+)))))
+ ;; Assume it's the empty list.
+ (error:%signal Qsetting-constant (list '()))))
+
+(declare (integrate-operator %symbol-value))
+(define (%symbol-value symbol)
+ (if (%%symbol? symbol)
+ (let ((%value (%symbol/value symbol)))
+ (cond ((eq? %value +not-global+) ((%symbol/get-value symbol)))
+ ((eq? %value +unbound+)
+ (error:%signal Qvoid-variable (list symbol)))
+ (else %value)))
+ ;; Assume it's the empty list.
+ '()))
-(define-integrable (%set-symbol-default! symbol value)
- ((%symbol/set-default! (->%symbol symbol)) value))
+(declare (integrate-operator %set-symbol-value!))
+(define (%set-symbol-value! symbol value)
+ (if (%%symbol? symbol)
+ (if (eq? symbol Qt)
+ (error:%signal Qsetting-constant (list Qt))
+ (let ((%value (%symbol/value symbol)))
+ (cond ((eq? %value +not-global+)
+ ((%symbol/set-value! symbol) value))
+ (else (set-%symbol/value! symbol value)))))
+ ;; Assume it's the empty list.
+ (error:%signal Qsetting-constant (list '()))))
+
+(declare (integrate-operator %symbol-default))
+(define (%symbol-default symbol)
+ (if (%%symbol? symbol)
+ (let ((%value (%symbol/value symbol)))
+ (cond ((eq? %value +not-global+) ((%symbol/get-default symbol)))
+ ((eq? %value +unbound+)
+ (error:%signal Qvoid-variable (list symbol)))
+ (else %value)))
+ ;; Assume it's the empty list.
+ '()))
-(define-integrable (%make-variable-buffer-local! symbol)
- ((%symbol/make-all-local! (->%symbol symbol))))
+(define (%set-symbol-default! symbol value)
+ (if (%%symbol? symbol)
+ (if (eq? symbol Qt)
+ (error:%signal Qsetting-constant (list Qt))
+ (let ((%value (%symbol/value symbol)))
+ (cond ((eq? %value +not-global+)
+ ((%symbol/set-default! symbol) value))
+ (else (set-%symbol/value! symbol value)))))
+ ;; Assume it's the empty list.
+ (error:%signal Qsetting-constant (list '()))))
+
+(define (%make-variable-buffer-local! symbol)
+ (if (and (%%symbol? symbol)
+ (not (eq? symbol Qt)))
+ (begin
+ (if (not (eq? +not-global+ (%symbol/value symbol)))
+ (%make-symbol-variable! symbol))
+ ((%symbol/make-all-local! symbol))))
+ unspecific)
-(define-integrable (%make-local-variable! symbol)
- ((%symbol/make-local! (->%symbol symbol))))
+(define (%make-local-variable! symbol)
+ (if (and (%%symbol? symbol)
+ (not (eq? symbol Qt)))
+ (begin
+ (if (not (eq? +not-global+ (%symbol/value symbol)))
+ (%make-symbol-variable! symbol))
+ ((%symbol/make-local! symbol))))
+ unspecific)
-(define-integrable (%kill-local-variable! symbol)
- ((%symbol/kill-local! (->%symbol symbol))))
+(define (%kill-local-variable! symbol)
+ (if (and (%%symbol? symbol)
+ (not (eq? symbol Qt))
+ (eq? +not-global+ (%symbol/value symbol)))
+ ((%symbol/kill-local! symbol)))
+ unspecific)
\f
;;;; Obarrays
\f
;;;; Coercion procedures.
-(define (%make-symbol-global! symbol)
- (let* ((bound? (%symbol-bound? symbol))
- (value (if bound? (%symbol-default symbol) '())))
- (let ((bound?
- (lambda ()
- bound?))
- (unbound!
- (lambda ()
- (set! bound? false)
- unspecific))
- (get-value
- (lambda ()
- (if bound?
- value
- (error:%signal Qvoid-variable (list (%symbol-> symbol))))))
- (set-value!
- (lambda (new-value)
- (set! bound? true)
- (set! value new-value)
- unspecific))
- (make-local!
- (lambda ()
- (%make-symbol-variable! symbol)
- ((%symbol/make-local! symbol))
- unspecific))
- (make-all-local!
- (lambda ()
- (%make-symbol-variable! symbol)
- ((%symbol/make-all-local! symbol))
- unspecific))
- (kill-local!
- (lambda ()
- unspecific))
- (set-docstring!
- (lambda (string)
- string
- unspecific)))
- (set-%symbol/bound?! symbol bound?)
- (set-%symbol/unbound!! symbol unbound!)
- (set-%symbol/get-value! symbol get-value)
- (set-%symbol/set-value!! symbol set-value!)
- (set-%symbol/get-default! symbol get-value)
- (set-%symbol/set-default!! symbol set-value!)
- (set-%symbol/make-local!! symbol make-local!)
- (set-%symbol/make-all-local!! symbol make-all-local!)
- (set-%symbol/kill-local!! symbol kill-local!)
- (set-%symbol/set-docstring!! symbol set-docstring!)
- unspecific)))
-
(define (%make-symbol-variable! symbol)
(let* ((existing-variable
(string-table-get editor-variables (%symbol-name symbol)))
variable-index:description
docstring))
unspecific)))
+ (set-%symbol/value! symbol +not-global+)
(set-%symbol/bound?! symbol bound?)
(set-%symbol/unbound!! symbol unbound!)
(set-%symbol/get-value! symbol get-value)
(set-%symbol/set-docstring!! symbol set-docstring!))))
(define (%make-symbol-generic! symbol get-value set-value!)
+ (set-%symbol/value! symbol +not-global+)
(set-%symbol/bound?! symbol true-procedure)
(set-%symbol/unbound!! symbol false-procedure)
(set-%symbol/get-value! symbol get-value)
(let ((Qnil (%%intern "nil" initial-obarray
(string-hash-mod "nil"
(vector-length initial-obarray)))))
- ((%symbol/set-value! Qnil) '())
- (set-%symbol/unbound!!
- Qnil (lambda (val) val (error:%signal Qsetting-constant (list '()))))
- (set-%symbol/set-value!!
- Qnil (lambda (val) val (error:%signal Qsetting-constant (list '()))))
- (set-%symbol/set-default!!
- Qnil (lambda (val) val (error:%signal Qsetting-constant (list '()))))
- (set-%symbol/make-local!! Qnil false-procedure)
- (set-%symbol/make-all-local!! Qnil false-procedure)
- (set-%symbol/kill-local!! Qnil false-procedure)
- (set-%symbol/set-docstring!! Qnil false-procedure)
+ (set-%symbol/value! Qnil '())
Qnil))
(define Qt
(let ((Qt (%%intern "t" initial-obarray
(string-hash-mod "t" (vector-length initial-obarray)))))
- ((%symbol/set-value! Qt) Qt)
- (set-%symbol/unbound!!
- Qt (lambda (val) val (error:%signal Qsetting-constant (list Qt))))
- (set-%symbol/set-value!!
- Qt (lambda (val) val (error:%signal Qsetting-constant (list Qt))))
- (set-%symbol/set-default!!
- Qt (lambda (val) val (error:%signal Qsetting-constant (list Qt))))
- (set-%symbol/make-local!! Qt false-procedure)
- (set-%symbol/make-all-local!! Qt false-procedure)
- (set-%symbol/kill-local!! Qt false-procedure)
- (set-%symbol/set-docstring!! Qt false-procedure)
+ (set-%symbol/value! Qt Qt)
Qt))
(define Qsetting-constant