← Back to branch summary

~ubuntu-branches/debian/sid/emacs24/sid

« back to all changes in this revision

Viewing changes to lisp/emacs-lisp/gv.el

  • Committer: Package Import Robot
  • Author(s): Rob Browning
  • Date: 2014-10-25 14:37:43 UTC
  • mfrom: (13.1.3 experimental)
  • Revision ID: package-import@ubuntu.com-20141025143743-m9q5reoyyyjq3p2h
Tags: 24.4+1-4
Update emacsen-common dependency as per policy.

Show diffs side-by-side

added added

removed removed

Lines of Context:
lisp/emacs-lisp/gv.el
1
1
;;; gv.el --- generalized variables  -*- lexical-binding: t -*-
2
2
 
3
 
;; Copyright (C) 2012-2013 Free Software Foundation, Inc.
 
3
;; Copyright (C) 2012-2014 Free Software Foundation, Inc.
4
4
 
5
5
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
6
6
;; Keywords: extensions
102
102
              ;; Follow aliases.
103
103
              (setq me (cons (symbol-function head) (cdr place))))
104
104
          (if (eq me place)
105
 
              (error "%S is not a valid place expression" place)
 
105
              (if (and (symbolp head) (get head 'setf-method))
 
106
                  (error "Incompatible place needs recompilation: %S" head)
 
107
                (error "%S is not a valid place expression" place))
106
108
            (gv-get me do)))))))
107
109
 
108
110
;;;###autoload
155
157
        (_ (message "Unknown %s declaration %S" symbol handler) nil))))
156
158
 
157
159
;;;###autoload
158
 
(push `(gv-expander ,(apply-partially #'gv--defun-declaration 'gv-expander))
159
 
      defun-declarations-alist)
 
160
(or (assq 'gv-expander defun-declarations-alist)
 
161
    (push `(gv-expander ,(apply-partially #'gv--defun-declaration 'gv-expander))
 
162
          defun-declarations-alist))
160
163
;;;###autoload
161
 
(push `(gv-setter ,(apply-partially #'gv--defun-declaration 'gv-setter))
162
 
      defun-declarations-alist)
 
164
(or (assq 'gv-setter defun-declarations-alist)
 
165
    (push `(gv-setter ,(apply-partially #'gv--defun-declaration 'gv-setter))
 
166
          defun-declarations-alist))
163
167
 
164
168
;; (defmacro gv-define-expand (name expander)
165
169
;;   "Use EXPANDER to handle NAME as a generalized var.
217
221
    temp)
218
222
so as to preserve the semantics of `setf'."
219
223
  (declare (debug (sexp (&or symbolp lambda-expr) &optional sexp)))
 
224
  (when (eq 'lambda (car-safe setter))
 
225
    (message "Use `gv-define-setter' or name %s's setter function" name))
220
226
  `(gv-define-setter ,name (val &rest args)
221
227
     ,(if fix-return
222
228
          `(macroexp-let2 nil v val
223
229
             `(progn
224
 
                (,',setter ,@(append args (list v)))
 
230
                (,',setter ,@args ,v)
225
231
                ,v))
226
 
        `(cons ',setter (append args (list val))))))
 
232
        ``(,',setter ,@args ,val))))
227
233
 
228
234
;;; Typical operations on generalized variables.
229
235
 
334
340
(gv-define-simple-setter process-filter set-process-filter)
335
341
(gv-define-simple-setter process-sentinel set-process-sentinel)
336
342
(gv-define-simple-setter process-get process-put)
337
 
(gv-define-simple-setter window-buffer set-window-buffer)
338
 
(gv-define-simple-setter window-display-table set-window-display-table 'fix)
339
 
(gv-define-simple-setter window-dedicated-p set-window-dedicated-p)
340
 
(gv-define-simple-setter window-hscroll set-window-hscroll)
341
343
(gv-define-simple-setter window-parameter set-window-parameter)
342
 
(gv-define-simple-setter window-point set-window-point)
343
 
(gv-define-simple-setter window-start set-window-start)
 
344
(gv-define-setter window-buffer (v &optional w)
 
345
  (macroexp-let2 nil v v
 
346
    `(progn (set-window-buffer ,w ,v) ,v)))
 
347
(gv-define-setter window-display-table (v &optional w)
 
348
  (macroexp-let2 nil v v
 
349
    `(progn (set-window-display-table ,w ,v) ,v)))
 
350
(gv-define-setter window-dedicated-p (v &optional w)
 
351
  `(set-window-dedicated-p ,w ,v))
 
352
(gv-define-setter window-hscroll (v &optional w) `(set-window-hscroll ,w ,v))
 
353
(gv-define-setter window-point (v &optional w) `(set-window-point ,w ,v))
 
354
(gv-define-setter window-start (v &optional w) `(set-window-start ,w ,v))
 
355
 
 
356
(gv-define-setter buffer-local-value (val var buf)
 
357
  (macroexp-let2 nil v val
 
358
    `(with-current-buffer ,buf (set (make-local-variable ,var) ,v))))
344
359
 
345
360
;;; Some occasionally handy extensions.
346
361
 
441
456
                       `(logior (logand ,v ,mask)
442
457
                                (logand ,getter (lognot ,mask))))))))))
443
458
 
 
459
;;; References
 
460
 
 
461
;;;###autoload
 
462
(defmacro gv-ref (place)
 
463
  "Return a reference to PLACE.
 
464
This is like the `&' operator of the C language.
 
465
Note: this only works reliably with lexical binding mode, except for very
 
466
simple PLACEs such as (function-symbol 'foo) which will also work in dynamic
 
467
binding mode."
 
468
  (gv-letplace (getter setter) place
 
469
    `(cons (lambda () ,getter)
 
470
           (lambda (gv--val) ,(funcall setter 'gv--val)))))
 
471
 
 
472
(defsubst gv-deref (ref)
 
473
  "Dereference REF, returning the referenced value.
 
474
This is like the `*' operator of the C language.
 
475
REF must have been previously obtained with `gv-ref'."
 
476
  (funcall (car ref)))
 
477
;; Don't use `declare' because it seems to introduce circularity problems:
 
478
;; Warning: Eager macro-expansion skipped due to cycle:
 
479
;;  … => (load "gv.el") => (macroexpand-all (defsubst gv-deref …)) => (macroexpand (defun …)) => (load "gv.el")
 
480
(gv-define-setter gv-deref (v ref) `(funcall (cdr ,ref) ,v))
 
481
 
444
482
;;; Vaguely related definitions that should be moved elsewhere.
445
483
 
446
484
;; (defun alist-get (key alist)