Mercurial > hg > xemacs-beta
diff lisp/cl-macs.el @ 371:cc15677e0335 r21-2b1
Import from CVS: tag r21-2b1
author | cvs |
---|---|
date | Mon, 13 Aug 2007 11:03:08 +0200 |
parents | a4f53d9b3154 |
children | 6240c7796c7a |
line wrap: on
line diff
--- a/lisp/cl-macs.el Mon Aug 13 11:01:58 2007 +0200 +++ b/lisp/cl-macs.el Mon Aug 13 11:03:08 2007 +0200 @@ -81,7 +81,7 @@ (function (lambda (n p f) (list 'put (list 'quote n) (list 'quote p) (list 'function (cons 'lambda f))))))) - 'xemacs)) + (car (or features (setq features (list 'cl-kludge)))))) ;;; Initialization. @@ -898,24 +898,20 @@ ((memq word '(frame frames screen screens)) (let ((temp (gensym))) - (cl-push (list var (if (eq cl-emacs-type 'lucid) - '(selected-screen) '(selected-frame))) + (cl-push (list var '(selected-frame)) loop-for-bindings) (cl-push (list temp nil) loop-for-bindings) (cl-push (list 'prog1 (list 'not (list 'eq var temp)) (list 'or temp (list 'setq temp var))) loop-body) - (cl-push (list var (list (if (eq cl-emacs-type 'lucid) - 'next-screen 'next-frame) var)) + (cl-push (list var (list 'next-frame var)) loop-for-steps))) ((memq word '(window windows)) (let ((scr (and (memq (car args) '(in of)) (cl-pop2 args))) (temp (gensym))) (cl-push (list var (if scr - (list (if (eq cl-emacs-type 'lucid) - 'screen-selected-window - 'frame-selected-window) scr) + (list 'frame-selected-window scr) '(selected-window))) loop-for-bindings) (cl-push (list temp nil) loop-for-bindings) @@ -1451,10 +1447,10 @@ (cond ((eq (car-safe spec) 'special) (if (boundp 'byte-compile-bound-variables) (setq byte-compile-bound-variables - (append - (mapcar #'(lambda (v) (cons v byte-compile-global-bit)) - (cdr spec)) - byte-compile-bound-variables)))) + ;; todo: this should compute correct binding bits vs. 0 + (append (mapcar #'(lambda (v) (cons v 0)) + (cdr spec)) + byte-compile-bound-variables)))) ((eq (car-safe spec) 'inline) (while (setq spec (cdr spec)) @@ -1655,17 +1651,16 @@ (defsetf default-file-modes set-default-file-modes t) (defsetf default-value set-default) (defsetf documentation-property put) -(defsetf extent-data set-extent-data) ; obsolete (defsetf extent-face set-extent-face) (defsetf extent-priority set-extent-priority) (defsetf extent-property (x y &optional d) (arg) (list 'set-extent-property x y arg)) +(defsetf extent-end-position (ext) (store) + (list 'progn (list 'set-extent-endpoints (list 'extent-start-position ext) + store) store)) (defsetf extent-start-position (ext) (store) - `(progn (set-extent-endpoints ,ext ,store (extent-end-position ,ext)) - ,store)) -(defsetf extent-end-position (ext) (store) - `(progn (set-extent-endpoints ,ext (extent-start-position ,ext) ,store) - ,store)) + (list 'progn (list 'set-extent-endpoints store + (list 'extent-end-position ext)) store)) (defsetf face-background (f &optional s) (x) (list 'set-face-background f x s)) (defsetf face-background-pixmap (f &optional s) (x) (list 'set-face-background-pixmap f x s)) @@ -1736,8 +1731,6 @@ ;; Avoid adding various face and glyph functions. (defsetf frame-selected-window (&optional f) (v) `(set-frame-selected-window ,f ,v)) -(defsetf glyph-image (glyph &optional domain) (i) - (list 'set-glyph-image glyph i domain)) (defsetf itimer-function set-itimer-function) (defsetf itimer-function-arguments set-itimer-function-arguments) (defsetf itimer-is-idle set-itimer-is-idle) @@ -1788,10 +1781,7 @@ (defsetf process-sentinel set-process-sentinel) (defsetf read-mouse-position (scr) (store) (list 'set-mouse-position scr (list 'car store) (list 'cdr store))) -(defsetf screen-height set-screen-height t) -(defsetf screen-width set-screen-width t) (defsetf selected-window select-window) -(defsetf selected-screen select-screen) (defsetf selected-frame select-frame) (defsetf standard-case-table set-standard-case-table) (defsetf syntax-table set-syntax-table)