cgit.sxemacs.org Git - packages/blob - xemacs-packages/hyperbole/kotl/kprop-xe.el

   1 ;;; kprop-xe.el --- Koutline text property handling under XEmacs.
   2
   3 ;; Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc.
   4 ;; Developed with support from Motorola Inc.
   5
   6 ;; Author: Bob Weiner, Brown U.
   7 ;; Maintainer: Mats Lidell <matsl@contactor.se>
   8 ;; Keywords: outlines, wp
   9
  10 ;; This file is part of GNU Hyperbole.
  11
  12 ;; GNU Hyperbole is free software; you can redistribute it and/or
  13 ;; modify it under the terms of the GNU General Public License as
  14 ;; published by the Free Software Foundation; either version 3, or (at
  15 ;; your option) any later version.
  16
  17 ;; GNU Hyperbole is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  20 ;; General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  25 ;; Boston, MA 02110-1301, USA.
  26
  27 ;;; Commentary:
  28
  29 ;;; Code:
  30
  31 ;;;
  32 ;;; Other required Elisp libraries
  33 ;;;
  34
  35 (require 'hversion)
  36
  37 ;;;
  38 ;;; Public functions
  39 ;;;
  40
  41 ;; (get-text-property (pos prop &optional object))
  42 ;; Return the value of position POS's property PROP, in OBJECT.
  43 ;; OBJECT is optional and defaults to the current buffer.
  44 ;; If POSITION is at the end of OBJECT, the value is nil.
  45 (fset 'kproperty:get 'get-text-property)
  46
  47 (if (and hyperb:xemacs-p (or (>= emacs-minor-version 12)
  48                              (> emacs-major-version 19)))
  49     (defun kproperty:map (function property &optional value)
  50       "Apply FUNCTION to each PROPERTY `eq' to VALUE in the current buffer.
  51 FUNCTION is called with point preceding PROPERTY and receives PROPERTY as an
  52 argument."
  53       (let ((result))
  54         (save-excursion
  55          (map-extents
  56           (function (lambda (extent unused)
  57                       (goto-char (or (extent-start-position extent) (point)))
  58                       (setq result (cons (funcall function extent) result))
  59                       nil))
  60           nil nil nil nil nil property value))
  61         (nreverse result)))
  62   (defun kproperty:map (function property &optional value)
  63     "Apply FUNCTION to each PROPERTY `eq' to VALUE in the current buffer.
  64 FUNCTION is called with point preceding PROPERTY and receives PROPERTY as an
  65 argument."
  66     (let ((result))
  67       (save-excursion
  68         (map-extents
  69          (function (lambda (extent unused)
  70                      (if (eq (extent-property extent property) value)
  71                          (progn (goto-char (or (extent-start-position extent)
  72                                                (point)))
  73                                 (setq result (cons (funcall function extent)
  74                                                    result))))
  75                      nil))))
  76       (nreverse result))))
  77
  78 ;; (next-single-property-change (pos prop &optional object))
  79 ;; Return the position of next property change for a specific property.
  80 ;; Scans characters forward from POS till it finds
  81 ;; a change in the PROP property, then returns the position of the change.
  82 ;; The optional third argument OBJECT is the string or buffer to scan.
  83 ;; Return nil if the property is constant all the way to the end of OBJECT.
  84 ;; If the value is non-nil, it is a position greater than POS, never equal.
  85 (fset 'kproperty:next-single-change 'next-single-property-change)
  86
  87 ;; (previous-single-property-change (pos prop &optional object))
  88 ;; Return the position of previous property change for a specific property.
  89 ;; Scans characters backward from POS till it finds
  90 ;; a change in the PROP property, then returns the position of the change.
  91 ;; The optional third argument OBJECT is the string or buffer to scan.
  92 ;; Return nil if the property is constant all the way to the start of OBJECT.
  93 ;; If the value is non-nil, it is a position less than POS, never equal.
  94 (fset 'kproperty:previous-single-change 'previous-single-property-change)
  95
  96 (fset 'kproperty:properties 'extent-properties-at)
  97
  98 (defun kproperty:put (start end property-list &optional object)
  99   "From START to END, add PROPERTY-LIST properties to the text.
 100 The optional fourth argument, OBJECT, is the string or buffer containing the
 101 text.  Text inserted before or after this region does not inherit the added
 102 properties."
 103   ;; Don't use text properties internally because they don't work as desired
 104   ;; when copied to a string and then reinserted.
 105   (let ((extent (make-extent start end object)))
 106     (if (null extent)
 107         (error "(kproperty:put): No extent at %d-%d to add properties %s"
 108                start end property-list))
 109     (if (/= (mod (length property-list) 2) 0)
 110         (error "(kproperty:put): Property-list has odd number of elements, %s"
 111                property-list))
 112     (set-extent-property extent 'text-prop t)
 113     (set-extent-property extent 'duplicable t)
 114     (set-extent-property extent 'start-open t)
 115     (set-extent-property extent 'end-open t)
 116     (while property-list
 117       (set-extent-property
 118        extent (car property-list) (car (cdr property-list)))
 119       (setq property-list (nthcdr 2 property-list)))
 120     extent))
 121
 122 (defun kproperty:remove (start end property-list &optional object)
 123   "From START to END, remove the text properties in PROPERTY-LIST.
 124 The optional fourth argument, OBJECT, is the string or buffer containing the
 125 text.  PROPERTY-LIST should be a plist; if the value of a property is
 126 non-nil, then only a property with a matching value will be removed.
 127 Returns t if any property was changed, nil otherwise."
 128   ;; Don't use text property functions internally because they only look for
 129   ;; closed extents, which kproperty does not use.
 130   (let ((changed) property value)
 131     (while property-list
 132       (setq property (car property-list)
 133             value (car (cdr property-list))
 134             property-list (nthcdr 2 property-list))
 135       (map-extents
 136        (function (lambda (extent maparg)
 137                    (if (extent-live-p extent)
 138                        (progn (setq changed t)
 139                               (delete-extent extent)))
 140                    nil))
 141        object start end nil nil property value))
 142     changed))
 143
 144 (defun kproperty:replace-separator (pos label-separator old-sep-len)
 145   "Replace at POS the cell label separator with LABEL-SEPARATOR.
 146 OLD-SEP-LEN is the length of the separator being replaced."
 147   (let (extent)
 148     (while (setq pos (kproperty:next-single-change (point) 'kcell))
 149       (goto-char pos)
 150       (setq extent (extent-at pos))
 151       ;; Replace label-separator while maintaining cell properties.
 152       (insert label-separator)
 153       (set-extent-endpoints extent pos (+ pos 2))
 154       (delete-region (point) (+ (point) old-sep-len)))))
 155
 156 (defun kproperty:set (property value)
 157   "Set PROPERTY of character at point to VALUE."
 158   (kproperty:put (point) (min (+ 2 (point)) (point-max))
 159                  (list property value)))
 160
 161 ;;; kprop-xe.el ends here