Mercurial > hg > xemacs-beta

comparison lisp/device.el @ 398:74fd4e045ea6 r21-2-29

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-29
author cvs
date Mon, 13 Aug 2007 11:13:30 +0200
parents 558f606b08ae
children 697ef44129c6
comparison
equal deleted inserted replaced
397:f4aeb21a5bad 398:74fd4e045ea6
29 29
30 ;; This file is dumped with XEmacs. 30 ;; This file is dumped with XEmacs.
31 31
32 ;;; Code: 32 ;;; Code:
33 33
34 ;;; Initialization
35
36 ; Specifier tag 'printer which matches printers
37 (define-specifier-tag 'printer (function device-printer-p))
38
39 ; Specifier tag 'display which matches displays
40 (define-specifier-tag 'display (function
41 (lambda (device)
42 (not (device-printer-p device)))))
43
44 ;;; Functions
45
34 (defun device-list () 46 (defun device-list ()
35 "Return a list of all devices." 47 "Return a list of all devices."
36 (apply 'nconc (mapcar 'console-device-list (console-list)))) 48 (apply 'nconc (mapcar 'console-device-list (console-list))))
37 49
38 (defun device-type (&optional device) 50 (defun device-type (&optional device)
39 "Return the type of the specified device (e.g. `x' or `tty'). 51 "Return the type of the specified device (e.g. `x' or `tty').
40 This is equivalent to the type of the device's console. 52 This is equivalent to the type of the device's console.
41 Value is `tty' for a tty device (a character-only terminal), 53 Value is `tty' for a tty device (a character-only terminal),
42 `x' for a device that is a screen on an X display, 54 `x' for a device that is a screen on an X display,
43 `ns' for a device that is a NeXTstep connection (not yet implemented), 55 `ns' for a device that is a NeXTstep connection (not yet implemented),
44 `mswindows' for a device that is a Windows or Windows NT connection, 56 `mswindows' for a device that is a MS Windows workstation,
45 `pc' for a device that is a direct-write MS-DOS screen (not yet implemented), 57 `msprinter' for a device that is a MS Windows printer connection,
46 `stream' for a stream device (which acts like a stdio stream), and 58 `stream' for a stream device (which acts like a stdio stream), and
47 `dead' for a deleted device." 59 `dead' for a deleted device."
48 (or device (setq device (selected-device))) 60 (or device (setq device (selected-device)))
49 (if (not (device-live-p device)) 'dead 61 (if (not (device-live-p device)) 'dead
50 (console-type (device-console device)))) 62 (console-type (device-console device))))
104 This generally means that there is support for the mouse, the menubar, 116 This generally means that there is support for the mouse, the menubar,
105 the toolbar, glyphs, etc." 117 the toolbar, glyphs, etc."
106 (or device (setq device (selected-device))) 118 (or device (setq device (selected-device)))
107 (console-on-window-system-p (device-console device))) 119 (console-on-window-system-p (device-console device)))
108 120
121 (defun call-device-method (name device &rest args)
122 "Call a DEVICE-specific function with the generic name NAME.
123 If DEVICE is not provided then the selected device is used."
124 (or device (setq device (selected-device)))
125 (or (symbolp name) (error "function name must be a symbol"))
126 (let ((devmeth (intern (concat (symbol-name
127 (device-type device)) "-" (symbol-name name)))))
128 (if (functionp devmeth)
129 (if args
130 (apply devmeth args)
131 (funcall devmeth))
132 nil)))
133
134 (defmacro define-device-method (name &optional docstring)
135 "Define NAME to be a device method."
136 `(defun ,name (&rest arglist) ,docstring
137 (apply 'call-device-method (quote ,name) nil arglist)))
138
139 (defmacro define-device-method* (name &optional docstring)
140 "Define NAME to be a device method."
141 `(defun* ,name (&rest arglist) ,docstring
142 (apply 'call-device-method (quote ,name) nil arglist)))
143
109 (defalias 'valid-device-type-p 'valid-console-type-p) 144 (defalias 'valid-device-type-p 'valid-console-type-p)
110 (defalias 'device-type-list 'console-type-list) 145 (defalias 'device-type-list 'console-type-list)
111 (defalias 'device-pixel-depth 'device-bitplanes) 146 (defalias 'device-pixel-depth 'device-bitplanes)
112 147
113 ;;; device.el ends here 148 ;;; device.el ends here