/[cmucl]/src/clx/dpms.lisp
ViewVC logotype

Contents of /src/clx/dpms.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (hide annotations)
Wed Jun 17 18:22:46 2009 UTC (4 years, 10 months ago) by rtoy
Branch: MAIN
CVS Tags: sparc-tramp-assem-base, post-merge-intl-branch, intl-branch-working-2010-02-19-1000, unicode-string-buffer-impl-base, release-20b-pre1, release-20b-pre2, unicode-string-buffer-base, sparc-tramp-assem-2010-07-19, amd64-dd-start, intl-2-branch-base, GIT-CONVERSION, cross-sol-x86-merged, intl-branch-working-2010-02-11-1000, RELEASE_20b, release-20a-base, cross-sol-x86-base, snapshot-2010-12, snapshot-2010-11, snapshot-2011-09, snapshot-2011-06, snapshot-2011-07, snapshot-2011-04, snapshot-2011-02, snapshot-2011-03, snapshot-2011-01, pre-merge-intl-branch, snapshot-2010-05, snapshot-2010-04, snapshot-2010-07, snapshot-2010-06, snapshot-2010-01, snapshot-2010-03, snapshot-2010-02, snapshot-2010-08, cross-sol-x86-2010-12-20, intl-branch-2010-03-18-1300, RELEASE_20a, release-20a-pre1, snapshot-2009-11, snapshot-2009-12, cross-sparc-branch-base, intl-branch-base, snapshot-2009-08, snapshot-2009-07, HEAD
Branch point for: cross-sparc-branch, RELEASE-20B-BRANCH, unicode-string-buffer-branch, sparc-tramp-assem-branch, RELEASE-20A-BRANCH, amd64-dd-branch, unicode-string-buffer-impl-branch, intl-branch, cross-sol-x86-branch, intl-2-branch
Changes since 1.2: +1 -1 lines
Merge portable-clx (2009-06-16) to main branch.  Tested by running
src/contrib/games/feebs and hemlock which works (in non-unicode
builds).
1 fgilham 1.1
2     ;;;; Original Author: Matthew Kennedy <mkennedy@gentoo.org>
3     ;;;;
4     ;;;; Documentation strings derived from DPMS.txt distributed with the Xorg X11
5     ;;;; server implementation. DPMS.txt contains the following copyright:
6     ;;;;
7     ;;;; Copyright (C) Digital Equipment Corporation, 1996
8     ;;;;
9     ;;;; Permission to use, copy, modify, distribute, and sell this documentation
10     ;;;; for any purpose is hereby granted without fee, provided that the above
11     ;;;; copyright notice and this permission notice appear in all copies. Digital
12     ;;;; Equipment Corporation makes no representations about the suitability for
13     ;;;; any purpose of the information in this document. This documentation is
14     ;;;; provided ``as is'' without express or implied warranty.
15    
16     #+cmu
17 rtoy 1.3 (ext:file-comment "$Id: dpms.lisp,v 1.3 2009/06/17 18:22:46 rtoy Rel $")
18 fgilham 1.1
19     (defpackage :dpms
20     (:use :common-lisp)
21     (:import-from :xlib
22     "DEFINE-EXTENSION"
23     "DISPLAY"
24     "WITH-BUFFER-REQUEST-AND-REPLY"
25     "WITH-BUFFER-REQUEST"
26     "EXTENSION-OPCODE"
27     "CARD8-GET"
28     "CARD16-GET"
29     "BOOLEAN-GET"
30     "CARD8"
31     "CARD16"
32     "DATA")
33     (:export "DPMS-GET-VERSION"
34     "DPMS-CAPABLE"
35     "DPMS-GET-TIMEOUTS"
36     "DPMS-SET-TIMEOUTS"
37     "DPMS-ENABLE"
38     "DPMS-DISABLE"
39     "DPMS-FORCE-LEVEL"
40     "DPMS-INFO"))
41    
42     (in-package :dpms)
43    
44     (define-extension "DPMS")
45    
46     (defmacro dpms-opcode (display)
47     `(extension-opcode ,display "DPMS"))
48    
49     (defconstant +get-version+ 0)
50     (defconstant +capable+ 1)
51     (defconstant +get-timeouts+ 2)
52     (defconstant +set-timeouts+ 3)
53     (defconstant +enable+ 4)
54     (defconstant +disable+ 5)
55     (defconstant +force-level+ 6)
56     (defconstant +info+ 7)
57    
58     (defun dpms-get-version (display &optional (major-version 1) (minor-version 1))
59     "Return two values: the major and minor version of the DPMS
60     implementation the server supports.
61    
62     If supplied, the MAJOR-VERSION and MINOR-VERSION indicate what
63     version of the protocol the client wants the server to implement."
64     (declare (type display display))
65     (with-buffer-request-and-reply (display (dpms-opcode display) nil)
66     ((data +get-version+)
67     (card16 major-version)
68     (card16 minor-version))
69     (values (card16-get 8)
70     (card16-get 10))))
71    
72     (defun dpms-capable (display)
73     "True if the currently running server's devices are capable of
74     DPMS operations.
75    
76     The truth value of this request is implementation defined, but is
77     generally based on the capabilities of the graphic card and
78     monitor combination. Also, the return value in the case of
79     heterogeneous multi-head servers is implementation defined."
80     (declare (type display display))
81     (with-buffer-request-and-reply (display (dpms-opcode display) nil)
82     ((data +capable+))
83     (boolean-get 8)))
84    
85     (defun dpms-get-timeouts (display)
86     "Return three values: the current values of the DPMS timeout
87     values. The timeout values are (in order returned): standby,
88     suspend and off. All values are in units of seconds. A value of
89     zero for any timeout value indicates that the mode is disabled."
90     (declare (type display display))
91     (with-buffer-request-and-reply (display (dpms-opcode display) nil)
92     ((data +get-timeouts+))
93     (values (card16-get 8)
94     (card16-get 10)
95     (card16-get 12))))
96    
97     (defun dpms-set-timeouts (display standby suspend off)
98     "Set the values of the DPMS timeouts. All values are in units
99     of seconds. A value of zero for any timeout value disables that
100     mode."
101     (declare (type display display))
102     (with-buffer-request (display (dpms-opcode display))
103     (data +set-timeouts+)
104     (card16 standby)
105     (card16 suspend)
106     (card16 off)
107     (card16 0)) ;unused
108     (values))
109    
110     (defun dpms-enable (display)
111     "Enable the DPMS characteristics of the server using the
112     server's currently stored timeouts. If DPMS is already enabled,
113     no change is affected."
114     (declare (type display display))
115     (with-buffer-request (display (dpms-opcode display))
116     (data +enable+))
117     (values))
118    
119     (defun dpms-disable (display)
120     "Disable the DPMS characteristics of the server. It does not
121     affect the core or extension screen savers. If DPMS is already
122     disabled, no change is effected.
123    
124     This request is provided so that DPMS may be disabled without
125     damaging the server's stored timeout values."
126     (declare (type display display))
127     (with-buffer-request (display (dpms-opcode display))
128     ((data +disable+)))
129     (values))
130    
131     (defun dpms-force-level (display power-level)
132     "Forces a specific DPMS level on the server. Valid keyword
133     values for POWER-LEVEL are: DPMS-MODE-ON, DPMS-MODE-STANDBY,
134     DPMS-MODE-SUSPEND and DPMS-MODE-OFF."
135     (declare (type display display))
136     (with-buffer-request (display (dpms-opcode display))
137     (data +force-level+)
138     (card16 (ecase power-level
139     (:dpms-mode-on 0)
140     (:dpms-mode-standby 1)
141     (:dpms-mode-suspend 2)
142     (:dpms-mode-off 3)))
143     (card16 0)) ;unused
144     (values))
145    
146     (defun dpms-info (display)
147     "Returns two valus: the DPMS power-level and state value for the display.
148    
149     State is one of the keywords DPMS-ENABLED or DPMS-DISABLED.
150    
151     If state is DPMS-ENABLED, then power level is returned as one of
152     the keywords DPMS-MODE-ON, DPMS-MODE-STANDBY, DPMS-MODE-SUSPEND
153     or DPMS-MODE-OFF. If state is DPMS-DISABLED, then power-level is
154     undefined and returned as NIL."
155     (declare (type display display))
156     (with-buffer-request-and-reply (display (dpms-opcode display) nil)
157     ((data +info+))
158     (let ((state (if (boolean-get 10)
159     :dpms-enabled
160     :dpms-disabled)))
161     (values (unless (eq state :dpms-disabled)
162     (ecase (card16-get 8)
163     (0 :dpms-mode-on)
164     (1 :dpms-mode-standby)
165     (2 :dpms-mode-suspend)
166     (3 :dpms-mode-off)))
167     state))))
168    
169     ;;; Local Variables:
170     ;;; indent-tabs-mode: nil
171     ;;; End:

  ViewVC Help
Powered by ViewVC 1.1.5