diff lisp/url/url-sysdp.el @ 2:ac2d302a0011 r19-15b2

Import from CVS: tag r19-15b2
author cvs
date Mon, 13 Aug 2007 08:46:35 +0200
parents 376386a54a3c
children
line wrap: on
line diff
--- a/lisp/url/url-sysdp.el	Mon Aug 13 08:45:53 2007 +0200
+++ b/lisp/url/url-sysdp.el	Mon Aug 13 08:46:35 2007 +0200
@@ -148,7 +148,8 @@
 (sysdep-defconst window-system-version 0)
 
 (sysdep-defvar list-buffers-directory nil)
-(sysdep-defvar x-library-search-path '("/usr/X11R6/lib/X11/"
+(sysdep-defvar x-library-search-path (`
+				      ("/usr/X11R6/lib/X11/"
 				       "/usr/X11R5/lib/X11/"
 				       "/usr/lib/X11R6/X11/"
 				       "/usr/lib/X11R5/X11/"
@@ -167,7 +168,10 @@
 				       "/usr/local/x11r5/lib/X11/"
 				       "/usr/lpp/Xamples/lib/X11/"
 				       "/usr/openwin/lib/X11/"
-				       "/usr/openwin/share/lib/X11/")
+				       "/usr/openwin/share/lib/X11/"
+				       (, data-directory)
+				       )
+				      )
   "Search path used for X11 libraries.")
 
 ;; frame-related stuff.
@@ -291,6 +295,15 @@
 
 (sysdep-defalias 'face-list 'list-faces)
 
+(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.
+  (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."
@@ -301,8 +314,32 @@
   "Return FACE's value of the given PROPERTY."
   (and (symbolp face) (get face property)))
 
+;; Property list functions
+;;
+(sysdep-defun plist-put (plist prop val)
+  "Change value in PLIST of PROP to VAL.
+PLIST is a property list, which is a list of the form
+(PROP1 VALUE1 PROP2 VALUE2 ...).  PROP is a symbol and VAL is any object.
+If PROP is already a property on the list, its value is set to VAL,
+otherwise the new PROP VAL pair is added.  The new plist is returned;
+use `(setq x (plist-put x prop val))' to be sure to use the new value.
+The PLIST is modified by side effects."
+  (let ((node (memq prop plist)))
+    (if node
+	(setcar (cdr node) val)
+      (setq plist (cons prop (cons val plist))))
+    plist))
+
+(sysdep-defun plist-get (plist prop)
+  "Extract a value from a property list.
+PLIST is a property list, which is a list of the form
+(PROP1 VALUE1 PROP2 VALUE2...).  This function returns the value
+corresponding to the given PROP, or nil if PROP is not
+one of the properties on the list."
+  (car-safe (cdr-safe (memq prop plist))))
+
 ;; Device functions
-;; By wmperry@spry.com
+;; 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.
@@ -457,7 +494,6 @@
       str))
    (t "stdio")))
 
-
 (sysdep-defun device-connection (&optional device)
   "Return the connection of the specified device.
 DEVICE defaults to the selected device if omitted"
@@ -555,6 +591,7 @@
 
 (sysdep-defalias 'device-class
   (cond
+   ;; First, Xwindows
    ((and (eq window-system 'x) (fboundp 'x-display-visual-class))
     (function
      (lambda (&optional device)
@@ -563,6 +600,22 @@
 	  ((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)
@@ -598,7 +651,8 @@
   "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 (cdr-safe (assq 'display (frame-parameters device-or-frame)))
+  (if (or (cdr-safe (assq 'display (frame-parameters device-or-frame)))
+	  (cdr-safe (assq 'window-id (frame-parameters device-or-frame))))
       window-system
     'tty))
 
@@ -628,6 +682,8 @@
 (sysdep-fset 'extent-end-position 'overlay-end)
 (sysdep-fset 'extent-start-position 'overlay-start)
 (sysdep-fset 'set-extent-endpoints 'move-overlay)
+(sysdep-fset 'set-extent-property 'overlay-put)
+(sysdep-fset 'make-extent 'make-overlay)
 
 (sysdep-defun extent-property (extent property &optional default)
   (or (overlay-get extent property) default))
@@ -649,7 +705,6 @@
 	      (< (- (extent-end-position a) (extent-start-position a))
 		 (- (extent-end-position b) (extent-start-position b)))))))))
 
-
 (sysdep-defun overlays-in (beg end)
   "Return a list of the overlays that overlap the region BEG ... END.
 Overlap means that at least one character is contained within the overlay
@@ -693,6 +748,12 @@
 	    (throw 'done tmp))))))
 
 ;; misc
+(sysdep-fset 'make-local-hook 'make-local-variable)
+
+(sysdep-defun buffer-substring-no-properties (beg end)
+  "Return the text from BEG to END, without text properties, as a string."
+  (format "%s" (buffer-substring beg end)))
+  
 (sysdep-defun symbol-value-in-buffer (symbol buffer &optional unbound-value)
   "Return the value of SYMBOL in BUFFER, or UNBOUND-VALUE if it is unbound."
   (save-excursion
@@ -796,6 +857,9 @@
 	 (fboundp 'color-defined-p))	; NS/Emacs 19
     'color-defined-p)
    ((and window-system
+	 (fboundp 'pm-color-defined-p))
+    'pm-color-defined-p)
+   ((and window-system
 	 (fboundp 'x-color-defined-p))	; Emacs 19
     'x-color-defined-p)
    ((fboundp 'get-color)		; Epoch
@@ -882,6 +946,12 @@
 (sysdep-defun find-face (face)
   (car-safe (memq face (face-list))))
 
+(sysdep-defun set-marker-insertion-type (marker type)
+  "Set the insertion-type of MARKER to TYPE.
+If TYPE is t, it means the marker advances when you insert text at it.
+If TYPE is nil, it means the marker stays behind when you insert text at it."
+  nil)
+
 ;; window functions
 
 ;; not defined in v18
@@ -894,7 +964,6 @@
   "Returns non-nil if WINDOW is a minibuffer window."
   (eq window (minibuffer-window)))
 
-;; not defined in v18
 (sysdep-defun window-live-p (window)
   "Returns t if OBJ is a window which is currently visible."
   (and (windowp window)