--- a/lisp/w3/w3-sysdp.el	Mon Aug 13 09:30:13 2007 +0200
+++ b/lisp/w3/w3-sysdp.el	Mon Aug 13 09:31:12 2007 +0200
@@ -322,104 +322,6 @@
     (if tail
 	(setcdr tail new-parent))))
 
-(sysdep-defun facep (face)
-  "Return t if X is a face name or an internal face vector."
-  ;; CAUTION!!! This is Emacs 19.x, for x <= 28, specific
-  ;; I know of no version of Lucid Emacs or XEmacs that did not have
-  ;; facep.  Even if they did, they are unsupported, so big deal.
-  (if (not window-system)
-      nil				; FIXME if FSF ever does TTY faces
-    (and (or (internal-facep face)
-	     (and (symbolp face) (assq face global-face-data)))
-	 t)))
-
-(sysdep-defun set-face-property (face property value &optional locale
-				      tag-set how-to-add)
-  "Change a property of FACE."
-  (and (symbolp face)
-       (put face property value)))
-
-(sysdep-defun face-property (face property &optional locale tag-set exact-p)
-  "Return FACE's value of the given PROPERTY."
-  (and (symbolp face) (get face property)))
-
-;;; Additional text property functions.
-
-;; The following three text property functions are not generally available (and
-;; it's not certain that they should be) so they are inlined for speed.
-;; The case for `fillin-text-property' is simple; it may or not be generally
-;; useful.  (Since it is used here, it is useful in at least one place.;-)
-;; However, the case for `append-text-property' and `prepend-text-property' is
-;; more complicated.  Should they remove duplicate property values or not?  If
-;; so, should the first or last duplicate item remain?  Or the one that was
-;; added?  In our implementation, the first duplicate remains.
-
-(sysdep-defun fillin-text-property (start end setprop markprop value &optional object)
-  "Fill in one property of the text from START to END.
-Arguments PROP and VALUE specify the property and value to put where none are
-already in place.  Therefore existing property values are not overwritten.
-Optional argument OBJECT is the string or buffer containing the text."
-  (let ((start (text-property-any start end markprop nil object)) next)
-    (while start
-      (setq next (next-single-property-change start markprop object end))
-      (put-text-property start next setprop value object)
-      (put-text-property start next markprop value object)
-      (setq start (text-property-any next end markprop nil object)))))
-
-;; This function (from simon's unique.el) is rewritten and inlined for speed.
-;(defun unique (list function)
-;  "Uniquify LIST, deleting elements using FUNCTION.
-;Return the list with subsequent duplicate items removed by side effects.
-;FUNCTION is called with an element of LIST and a list of elements from LIST,
-;and should return the list of elements with occurrences of the element removed,
-;i.e., a function such as `delete' or `delq'.
-;This function will work even if LIST is unsorted.  See also `uniq'."
-;  (let ((list list))
-;    (while list
-;      (setq list (setcdr list (funcall function (car list) (cdr list))))))
-;  list)
-
-(sysdep-defun unique (list)
-  "Uniquify LIST, deleting elements using `delq'.
-Return the list with subsequent duplicate items removed by side effects."
-  (let ((list list))
-    (while list
-      (setq list (setcdr list (delq (car list) (cdr list))))))
-  list)
-
-;; A generalisation of `facemenu-add-face' for any property, but without the
-;; removal of inactive faces via `facemenu-discard-redundant-faces' and special
-;; treatment of `default'.  Uses `unique' to remove duplicate property values.
-(sysdep-defun prepend-text-property (start end prop value &optional object)
-  "Prepend to one property of the text from START to END.
-Arguments PROP and VALUE specify the property and value to prepend to the value
-already in place.  The resulting property values are always lists, and unique.
-Optional argument OBJECT is the string or buffer containing the text."
-  (let ((val (if (listp value) value (list value))) next prev)
-    (while (/= start end)
-      (setq next (next-single-property-change start prop object end)
-	    prev (get-text-property start prop object))
-      (put-text-property
-       start next prop
-       (unique (append val (if (listp prev) prev (list prev))))
-       object)
-      (setq start next))))
-
-(sysdep-defun append-text-property (start end prop value &optional object)
-  "Append to one property of the text from START to END.
-Arguments PROP and VALUE specify the property and value to append to the value
-already in place.  The resulting property values are always lists, and unique.
-Optional argument OBJECT is the string or buffer containing the text."
-  (let ((val (if (listp value) value (list value))) next prev)
-    (while (/= start end)
-      (setq next (next-single-property-change start prop object end)
-	    prev (get-text-property start prop object))
-      (put-text-property
-       start next prop
-       (unique (append (if (listp prev) prev (list prev)) val))
-       object)
-      (setq start next))))
-
 (sysdep-defun buffer-substring-no-properties (st nd)
   "Return the characters of part of the buffer, without the text properties.
 The two arguments START and END are character positions;
@@ -452,349 +354,6 @@
     (setq plist (cdr (cdr plist))))
   (and plist (car (cdr plist))))
 
-;; Device functions
-;; By wmperry@cs.indiana.edu
-;; This is a complete implementation of all the device-* functions found in
-;; XEmacs 19.14.  A 'device' for Emacs 19 is just a frame, from which we can
-;; determine the connection to an X display, etc.
-
-(sysdep-defalias 'selected-device 'ignore)
-(sysdep-defalias 'device-or-frame-p 'framep)
-(sysdep-defalias 'device-console 'ignore)
-(sysdep-defalias 'device-sound-enabled-p 'ignore)
-(sysdep-defalias 'device-live-p 'frame-live-p)
-(sysdep-defalias 'devicep 'framep)
-(sysdep-defalias 'frame-device 'identity)
-(sysdep-defalias 'redisplay-device 'redraw-frame)
-(sysdep-defalias 'redraw-device 'redraw-frame)
-(sysdep-defalias 'select-device 'select-frame)
-(sysdep-defalias 'set-device-class 'ignore)
-
-(sysdep-defun make-device (type connection &optional props)
-  "Create a new device of type TYPE, attached to connection CONNECTION.
-
-The valid values for CONNECTION are device-specific; however,
-CONNECTION is generally a string. (Specifically, for X devices,
-CONNECTION should be a display specification such as \"foo:0\", and
-for TTY devices, CONNECTION should be the filename of a TTY device
-file, such as \"/dev/ttyp4\", or nil to refer to XEmacs' standard
-input/output.)
-
-PROPS, if specified, should be a plist of properties controlling
-device creation.
-
-If CONNECTION specifies an already-existing device connection, that
-device is simply returned; no new device is created, and PROPS
-have no effect."
-  (cond
-   ((and (eq type 'x) connection)
-    (make-frame-on-display connection props))
-   ((eq type 'x)
-    (make-frame props))
-   ((eq type 'tty)
-    nil)
-   (t
-    (error "Unsupported device-type: %s" type))))
-
-(sysdep-defun make-frame-on-device (type connection &optional props)
-  "Create a frame of type TYPE on CONNECTION.
-TYPE should be a symbol naming the device type, i.e. one of
-
-x	An X display.  CONNECTION should be a standard display string
-	such as \"unix:0\", or nil for the display specified on the
-	command line or in the DISPLAY environment variable.  Only if
-	support for X was compiled into	XEmacs.
-tty	A standard TTY connection or terminal.  CONNECTION should be
-	a TTY device name such as \"/dev/ttyp2\" (as determined by
-	the Unix command `tty') or nil for XEmacs' standard input
-	and output (usually the TTY in which XEmacs started).  Only
-	if support for TTY's was compiled into XEmacs.
-ns	A connection to a machine running the NeXTstep windowing
-	system.  Not currently implemented.
-win32	A connection to a machine running Microsoft Windows NT or
-	Windows 95.  Not currently implemented.
-pc	A direct-write MS-DOS frame.  Not currently implemented.
-
-PROPS should be an plist of properties, as in the call to `make-frame'.
-
-If a connection to CONNECTION already exists, it is reused; otherwise,
-a new connection is opened."
-  (make-device type connection props))
-
-(sysdep-defun make-tty-device (&optional tty terminal-type)
-  "Create a new device on TTY.
-  TTY should be the name of a tty device file (e.g. \"/dev/ttyp3\" under
-SunOS et al.), as returned by the `tty' command.  A value of nil means
-use the stdin and stdout as passed to XEmacs from the shell.
-  If TERMINAL-TYPE is non-nil, it should be a string specifying the
-type of the terminal attached to the specified tty.  If it is nil,
-the terminal type will be inferred from the TERM environment variable."
-  (make-device 'tty tty (list 'terminal-type terminal-type)))
-
-(sysdep-defun make-x-device (&optional display)
-  (make-device 'x display))
-
-(sysdep-defun set-device-selected-frame (device frame)
-  "Set the selected frame of device object DEVICE to FRAME.
-If DEVICE is nil, the selected device is used.
-If DEVICE is the selected device, this makes FRAME the selected frame."
-  (select-frame frame))
-
-(sysdep-defun set-device-baud-rate (device rate)
-  "Set the output baud rate of DEVICE to RATE.
-On most systems, changing this value will affect the amount of padding
-and other strategic decisions made during redisplay."
-  (setq baud-rate rate))
-
-(sysdep-defun dfw-device (obj)
-  "Given a device, frame, or window, return the associated device.
-Return nil otherwise."
-  (cond
-   ((windowp obj)
-    (window-frame obj))
-   ((framep obj)
-    obj)
-   (t
-    nil)))
-
-(sysdep-defun event-device (event)
-  "Return the device that EVENT occurred on.
-This will be nil for some types of events (e.g. keyboard and eval events)."
-  (dfw-device (posn-window (event-start event))))
-
-(sysdep-defun find-device (connection &optional type)
-  "Look for an existing device attached to connection CONNECTION.
-Return the device if found; otherwise, return nil.
-
-If TYPE is specified, only return devices of that type; otherwise,
-return devices of any type. (It is possible, although unlikely,
-that two devices of different types could have the same connection
-name; in such a case, the first device found is returned.)"
-  (let ((devices (device-list))
-	(retval nil))
-    (while (and devices (not nil))
-      (if (equal connection (device-connection (car devices)))
-	  (setq retval (car devices)))
-      (setq devices (cdr devices)))
-    retval))
-
-(sysdep-defalias 'get-device 'find-device)
-
-(sysdep-defun device-baud-rate (&optional device)
-  "Return the output baud rate of DEVICE."
-  baud-rate)
-
-(sysdep-defun device-on-window-system-p (&optional device)
-  "Return non-nil if DEVICE is on a window system.
-This generally means that there is support for the mouse, the menubar,
-the toolbar, glyphs, etc."
-  (and (cdr-safe (assq 'display (frame-parameters device))) t))
-
-(sysdep-defun device-name (&optional device)
-  "Return the name of the specified device."
-  ;; doesn't handle the 19.29 multiple X display stuff yet
-  ;; doesn't handle NeXTStep either
-  (cond
-   ((null window-system) "stdio")
-   ((getenv "DISPLAY")
-    (let ((str (getenv "DISPLAY"))
-	  (x (1- (length (getenv "DISPLAY"))))
-	  (y 0))
-      (while (/= y x)
-	(if (or (= (aref str y) ?:)
-		(= (aref str y) ?.))
-	    (aset str y ?-))
-	(setq y (1+ y)))
-      str))
-   (t "stdio")))
-
-(sysdep-defun device-connection (&optional device)
-  "Return the connection of the specified device.
-DEVICE defaults to the selected device if omitted"
-  (or (cdr-safe (assq 'display (frame-parameters device))) "stdio"))
-
-(sysdep-defun device-frame-list (&optional device)
-  "Return a list of all frames on DEVICE.
-If DEVICE is nil, the selected device will be used."
-  (let ((desired (device-connection device)))
-    (filtered-frame-list (function (lambda (x) (equal (device-connection x)
-						      desired))))))
-(sysdep-defun device-list ()
-  "Return a list of all devices"
-  (let ((seen nil)
-	(cur nil)
-	(conn nil)
-	(retval nil)
-	(not-heard (frame-list)))
-    (while not-heard
-      (setq cur (car not-heard)
-	    conn (device-connection cur)
-	    not-heard (cdr not-heard))
-      (if (member conn seen)
-	  nil				; Already got it
-	(setq seen (cons conn seen)	; Whoo hoo, a new one!
-	      retval (cons cur retval))))
-    retval))
-
-(sysdep-defvar delete-device-hook nil
-  "Function or functions to call when a device is deleted.
-One argument, the to-be-deleted device.")
-
-(sysdep-defun delete-device (device &optional force)
-  "Delete DEVICE, permanently eliminating it from use.
-Normally, you cannot delete the last non-minibuffer-only frame (you must
-use `save-buffers-kill-emacs' or `kill-emacs').  However, if optional
-second argument FORCE is non-nil, you can delete the last frame. (This
-will automatically call `save-buffers-kill-emacs'.)"
-  (let ((frames (device-frame-list device)))
-    (run-hook-with-args 'delete-device-hook device)
-    (while frames
-      (delete-frame (car frames) force)
-      (setq frames (cdr frames)))))
-
-(sysdep-defalias 'device-color-cells
-  (cond
-   ((null window-system) 'ignore)
-   ((fboundp 'display-color-cells) 'display-color-cells)
-   ((fboundp 'x-display-color-cells) 'x-display-color-cells)
-   ((fboundp 'ns-display-color-cells) 'ns-display-color-celles)
-   (t 'ignore)))
-
-(sysdep-defun try-font-name (fontname &rest args)
-  (cond
-   ((eq window-system 'x) (car-safe (x-list-fonts fontname)))
-   ((eq window-system 'ns) (car-safe (ns-list-fonts fontname)))
-   ((eq window-system 'win32) (car-safe (x-list-fonts fontname)))
-   ((eq window-system 'pm) (car-safe (x-list-fonts fontname)))
-   (t nil)))
-
-(sysdep-defalias 'device-pixel-width
-  (cond
-   ((and (memq window-system '(x win32 pm)) (fboundp 'x-display-pixel-width))
-    'x-display-pixel-width)
-   ((and (eq window-system 'ns) (fboundp 'ns-display-pixel-width))
-    'ns-display-pixel-width)
-   (t 'ignore)))
-
-(sysdep-defalias 'device-pixel-height
-  (cond
-   ((and (memq window-system '(x win32 pm)) (fboundp 'x-display-pixel-height))
-    'x-display-pixel-height)
-   ((and (eq window-system 'ns) (fboundp 'ns-display-pixel-height))
-    'ns-display-pixel-height)
-   (t 'ignore)))
-
-(sysdep-defalias 'device-mm-width
-  (cond
-   ((and (memq window-system '(x win32 pm)) (fboundp 'x-display-mm-width))
-    'x-display-mm-width)
-   ((and (eq window-system 'ns) (fboundp 'ns-display-mm-width))
-    'ns-display-mm-width)
-   (t 'ignore)))
-
-(sysdep-defalias 'device-mm-height
-  (cond
-   ((and (memq window-system '(x win32 pm)) (fboundp 'x-display-mm-height))
-    'x-display-mm-height)
-   ((and (eq window-system 'ns) (fboundp 'ns-display-mm-height))
-    'ns-display-mm-height)
-   (t 'ignore)))
-
-(sysdep-defalias 'device-bitplanes
-  (cond
-   ((and (memq window-system '(x win32 pm)) (fboundp 'x-display-planes))
-    'x-display-planes)
-   ((and (eq window-system 'ns) (fboundp 'ns-display-planes))
-    'ns-display-planes)
-   (t 'ignore)))
-
-(sysdep-defalias 'device-class
-  (cond
-   ;; First, Xwindows
-   ((and (eq window-system 'x) (fboundp 'x-display-visual-class))
-    (function
-     (lambda (&optional device)
-       (let ((val (symbol-name (x-display-visual-class device))))
-	 (cond
-	  ((string-match "color" val) 'color)
-	  ((string-match "gray-scale" val) 'grayscale)
-	  (t 'mono))))))
-   ;; Now, Presentation-Manager under OS/2
-   ((and (eq window-system 'pm) (fboundp 'pm-display-visual-class))
-    (function
-     (lambda (&optional device)
-       (let ((val (symbol-name (pm-display-visual-class device))))
-	 (cond
-	  ((string-match "color" val) 'color)
-	  ((string-match "gray-scale" val) 'grayscale)
-	  (t 'mono))))))
-   ;; A slightly different way of doing it under OS/2
-   ((and (eq window-system 'pm) (fboundp 'pm-display-color-p))
-    (function
-     (lambda (&optional device)
-       (if (pm-display-color-p)
-	   'color
-	 'mono))))
-   ((fboundp 'number-of-colors)
-    (function
-     (lambda (&optional device)
-       (if (= 2 (number-of-colors))
-	   'mono
-	 'color))))
-   ((and (eq window-system 'x) (fboundp 'x-color-p))
-    (function
-     (lambda (&optional device)
-       (if (x-color-p)
-	   'color
-	 'mono))))
-   ((and (eq window-system 'ns) (fboundp 'ns-display-visual-class))
-    (function
-     (lambda (&optional device)
-       (let ((val (symbol-name (ns-display-visual-class))))
-	 (cond
-	  ((string-match "color" val) 'color)
-	  ((string-match "gray-scale" val) 'grayscale)
-	  (t 'mono))))))
-   (t (function (lambda (&optional device) 'color)))))
-
-(sysdep-defun device-class-list ()
-  "Returns a list of valid device classes."
-  (list 'color 'grayscale 'mono))
-
-(sysdep-defun valid-device-class-p (class)
-  "Given a CLASS, return t if it is valid.
-Valid classes are 'color, 'grayscale, and 'mono."
-  (memq class (device-class-list)))
-
-(sysdep-defun device-or-frame-type (device-or-frame)
-  "Return the type (e.g. `x' or `tty') of DEVICE-OR-FRAME.
-DEVICE-OR-FRAME should be a device or a frame object.  See `device-type'
-for a description of the possible types."
-  (if (or (cdr-safe (assq 'display (frame-parameters device-or-frame)))
-	  (cdr-safe (assq 'window-id (frame-parameters device-or-frame))))
-      window-system
-    'tty))
-
-(sysdep-defun device-type (&optional device)
-  "Return the type of the specified device (e.g. `x' or `tty').
-Value is `tty' for a tty device (a character-only terminal),
-`x' for a device which is a connection to an X server,
-'ns' for a device which is a connection to a NeXTStep dps server,
-'win32' for a Windows-NT window,
-'pm' for an OS/2 Presentation Manager window,
-'intuition' for an Amiga screen"
-  (device-or-frame-type device))
-
-(sysdep-defun device-type-list ()
-  "Return a list of valid console types."
-  (if window-system
-      (list window-system 'tty)
-    (list 'tty)))
-
-(sysdep-defun valid-device-type-p (type)
-  "Given a TYPE, return t if it is valid."
-  (memq type (device-type-list)))
-
 ;; Extent stuff
 (sysdep-fset 'delete-extent 'delete-overlay)
 (sysdep-fset 'extent-end-position 'overlay-end)