;;!emacs
;;
;; FILE:         kprop-xe.el
;; SUMMARY:      Koutline text property handling under XEmacs.
;; USAGE:        XEmacs Lisp Library
;; KEYWORDS:     outlines, wp
;;
;; AUTHOR:       Bob Weiner
;;
;; ORIG-DATE:    7/27/93
;; LAST-MOD:     21-Jun-95 at 00:50:49 by Bob Weiner
;;
;; This file is part of Hyperbole.
;; Available for use and distribution under the same terms as GNU Emacs.
;;
;; Copyright (C) 1993-1995, Free Software Foundation, Inc.
;; Developed with support from Motorola Inc.
;;
;; DESCRIPTION:  
;; DESCRIP-END.

;;; ************************************************************************
;;; Other required Elisp libraries
;;; ************************************************************************

(require 'hversion)

;;; ************************************************************************
;;; Public functions
;;; ************************************************************************

;; (get-text-property (pos prop &optional object))
;; Return the value of position POS's property PROP, in OBJECT.
;; OBJECT is optional and defaults to the current buffer.
;; If POSITION is at the end of OBJECT, the value is nil.
(fset 'kproperty:get 'get-text-property)

(if (and hyperb:xemacs-p (or (>= emacs-minor-version 12)
			     (> emacs-major-version 19)))
    (defun kproperty:map (function property &optional value)
      "Apply FUNCTION to each PROPERTY `eq' to VALUE in the current buffer."
      (let ((result))
	(map-extents
	 (function (lambda (extent unused)
		     (setq result (cons (funcall function extent) result))
		     nil))
	 nil nil nil nil nil property value)
	(nreverse result)))
  (defun kproperty:map (function property &optional value)
    "Apply FUNCTION to each PROPERTY `eq' to VALUE in the current buffer."
    (let ((result))
      (map-extents
       (function (lambda (extent unused)
		   (if (eq (extent-property extent property) value)
		       (setq result (cons (funcall function extent)
					  result)))
		   nil)))
      (nreverse result))))

;; (next-single-property-change (pos prop &optional object))
;; Return the position of next property change for a specific property.
;; Scans characters forward from POS till it finds
;; a change in the PROP property, then returns the position of the change.
;; The optional third argument OBJECT is the string or buffer to scan.
;; Return nil if the property is constant all the way to the end of OBJECT.
;; If the value is non-nil, it is a position greater than POS, never equal.
(fset 'kproperty:next-single-change 'next-single-property-change)

;; (previous-single-property-change (pos prop &optional object))
;; Return the position of previous property change for a specific property.
;; Scans characters backward from POS till it finds
;; a change in the PROP property, then returns the position of the change.
;; The optional third argument OBJECT is the string or buffer to scan.
;; Return nil if the property is constant all the way to the start of OBJECT.
;; If the value is non-nil, it is a position less than POS, never equal.
(fset 'kproperty:previous-single-change 'previous-single-property-change)

;; (text-properties-at (pos &optional object))
;; Return the list of properties held by the character at POSITION
;; in optional argument OBJECT, a string or buffer.  If nil, OBJECT
;; defaults to the current buffer.
;; If POSITION is at the end of OBJECT, the value is nil.
(fset 'kproperty:properties 'text-properties-at)

(defun kproperty:put (start end prop value &optional object)
  "Set one property of the text from START to END.
The third and fourth arguments PROP and VALUE specify the property to add.
The optional fifth argument, OBJECT, is the string or buffer containing the
text."
  ;; Don't use text properties internally because they don't work as desired
  ;; when copied to a string and then reinserted.
  (let ((extent (make-extent start end object)))
    (if (null extent)
	(error "(kproperty:put): No extent at %d-%d to put %s=%s" 
	       start end prop value)
      (set-extent-property extent prop value)
      (set-extent-property extent 'text-prop t)
      (set-extent-property extent 'duplicable t)
      (set-extent-property extent 'start-open t)
      (set-extent-property extent 'end-open t)
      extent)))

(fset 'kproperty:remove 'remove-text-properties)

(defun kproperty:set (property value)
  "Set PROPERTY of character at point to VALUE."
  (kproperty:put (point) (min (+ 2 (point)) (point-max)) property value))
