home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.004 / xemacs-1 / xemacs-19.13 / lisp / hyperbole / kotl / kprop-xe.el < prev    next >
Encoding:
Text File  |  1995-06-21  |  4.4 KB  |  108 lines
  1. ;;!emacs
  2. ;;
  3. ;; FILE:         kprop-xe.el
  4. ;; SUMMARY:      Koutline text property handling under XEmacs.
  5. ;; USAGE:        XEmacs Lisp Library
  6. ;; KEYWORDS:     outlines, wp
  7. ;;
  8. ;; AUTHOR:       Bob Weiner
  9. ;;
  10. ;; ORIG-DATE:    7/27/93
  11. ;; LAST-MOD:     21-Jun-95 at 00:50:49 by Bob Weiner
  12. ;;
  13. ;; This file is part of Hyperbole.
  14. ;; Available for use and distribution under the same terms as GNU Emacs.
  15. ;;
  16. ;; Copyright (C) 1993-1995, Free Software Foundation, Inc.
  17. ;; Developed with support from Motorola Inc.
  18. ;;
  19. ;; DESCRIPTION:  
  20. ;; DESCRIP-END.
  21.  
  22. ;;; ************************************************************************
  23. ;;; Other required Elisp libraries
  24. ;;; ************************************************************************
  25.  
  26. (require 'hversion)
  27.  
  28. ;;; ************************************************************************
  29. ;;; Public functions
  30. ;;; ************************************************************************
  31.  
  32. ;; (get-text-property (pos prop &optional object))
  33. ;; Return the value of position POS's property PROP, in OBJECT.
  34. ;; OBJECT is optional and defaults to the current buffer.
  35. ;; If POSITION is at the end of OBJECT, the value is nil.
  36. (fset 'kproperty:get 'get-text-property)
  37.  
  38. (if (and hyperb:xemacs-p (or (>= emacs-minor-version 12)
  39.                  (> emacs-major-version 19)))
  40.     (defun kproperty:map (function property &optional value)
  41.       "Apply FUNCTION to each PROPERTY `eq' to VALUE in the current buffer."
  42.       (let ((result))
  43.     (map-extents
  44.      (function (lambda (extent unused)
  45.              (setq result (cons (funcall function extent) result))
  46.              nil))
  47.      nil nil nil nil nil property value)
  48.     (nreverse result)))
  49.   (defun kproperty:map (function property &optional value)
  50.     "Apply FUNCTION to each PROPERTY `eq' to VALUE in the current buffer."
  51.     (let ((result))
  52.       (map-extents
  53.        (function (lambda (extent unused)
  54.            (if (eq (extent-property extent property) value)
  55.                (setq result (cons (funcall function extent)
  56.                       result)))
  57.            nil)))
  58.       (nreverse result))))
  59.  
  60. ;; (next-single-property-change (pos prop &optional object))
  61. ;; Return the position of next property change for a specific property.
  62. ;; Scans characters forward from POS till it finds
  63. ;; a change in the PROP property, then returns the position of the change.
  64. ;; The optional third argument OBJECT is the string or buffer to scan.
  65. ;; Return nil if the property is constant all the way to the end of OBJECT.
  66. ;; If the value is non-nil, it is a position greater than POS, never equal.
  67. (fset 'kproperty:next-single-change 'next-single-property-change)
  68.  
  69. ;; (previous-single-property-change (pos prop &optional object))
  70. ;; Return the position of previous property change for a specific property.
  71. ;; Scans characters backward from POS till it finds
  72. ;; a change in the PROP property, then returns the position of the change.
  73. ;; The optional third argument OBJECT is the string or buffer to scan.
  74. ;; Return nil if the property is constant all the way to the start of OBJECT.
  75. ;; If the value is non-nil, it is a position less than POS, never equal.
  76. (fset 'kproperty:previous-single-change 'previous-single-property-change)
  77.  
  78. ;; (text-properties-at (pos &optional object))
  79. ;; Return the list of properties held by the character at POSITION
  80. ;; in optional argument OBJECT, a string or buffer.  If nil, OBJECT
  81. ;; defaults to the current buffer.
  82. ;; If POSITION is at the end of OBJECT, the value is nil.
  83. (fset 'kproperty:properties 'text-properties-at)
  84.  
  85. (defun kproperty:put (start end prop value &optional object)
  86.   "Set one property of the text from START to END.
  87. The third and fourth arguments PROP and VALUE specify the property to add.
  88. The optional fifth argument, OBJECT, is the string or buffer containing the
  89. text."
  90.   ;; Don't use text properties internally because they don't work as desired
  91.   ;; when copied to a string and then reinserted.
  92.   (let ((extent (make-extent start end object)))
  93.     (if (null extent)
  94.     (error "(kproperty:put): No extent at %d-%d to put %s=%s" 
  95.            start end prop value)
  96.       (set-extent-property extent prop value)
  97.       (set-extent-property extent 'text-prop t)
  98.       (set-extent-property extent 'duplicable t)
  99.       (set-extent-property extent 'start-open t)
  100.       (set-extent-property extent 'end-open t)
  101.       extent)))
  102.  
  103. (fset 'kproperty:remove 'remove-text-properties)
  104.  
  105. (defun kproperty:set (property value)
  106.   "Set PROPERTY of character at point to VALUE."
  107.   (kproperty:put (point) (min (+ 2 (point)) (point-max)) property value))
  108.