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

   1 ;;; kprop-em.el --- Koutline text property handling under Emacs 19.
   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 (fset 'kproperty:get 'get-text-property)
  42
  43 (defun kproperty:map (function property value)
  44   "Apply FUNCTION to each PROPERTY `eq' to VALUE in the current buffer.
  45 FUNCTION is called with point preceding PROPERTY and receives the list of
  46 properties at point as an argument.  FUNCTION may not modify this list of
  47 properties."
  48   (let ((result)
  49         (start (point-min)))
  50     (save-excursion
  51       (while (setq start
  52                    (text-property-any start (point-max) property value))
  53         (goto-char start)
  54         (setq result (cons (funcall function (text-properties-at start))
  55                            result))))
  56     (nreverse result)))
  57
  58 (fset 'kproperty:next-single-change 'next-single-property-change)
  59
  60 (fset 'kproperty:previous-single-change 'previous-single-property-change)
  61
  62 (fset 'kproperty:properties 'text-properties-at)
  63
  64 (defun kproperty:put (start end property-list &optional object)
  65   "From START to END, add PROPERTY-LIST properties to the text.
  66 The optional fourth argument, OBJECT, is the string or buffer containing the
  67 text.  Text inserted before or after this region does not inherit the added
  68 properties."
  69   (add-text-properties
  70    start end (append property-list '(rear-nonsticky t)) object))
  71
  72 (defun kproperty:remove (start end property-list &optional object)
  73   "From START to END, remove the text properties in PROPERTY-LIST.
  74 The optional fourth argument, OBJECT, is the string or buffer containing the
  75 text.  PROPERTY-LIST should be a plist; if the value of a property is
  76 non-nil, then only a property with a matching value will be removed.
  77 Returns t if any property was changed, nil otherwise."
  78   (let ((changed) plist property value next)
  79     (while property-list
  80       (setq property (car property-list)
  81             value (car (cdr property-list))
  82             plist (list property value)
  83             property-list (nthcdr 2 property-list)
  84             next start)
  85       (while (setq next (text-property-any next end property value object))
  86         (remove-text-properties next (1+ next) plist object)
  87         (setq changed t next (1+ next))))
  88     changed))
  89
  90 (defun kproperty:replace-separator (pos label-separator old-sep-len)
  91   "Replace at POS the cell label separator with LABEL-SEPARATOR.
  92 OLD-SEP-LEN is the length of the separator being replaced."
  93   (let (properties)
  94     (while (setq pos (kproperty:next-single-change (point) 'kcell))
  95       (goto-char pos)
  96       (setq properties (text-properties-at pos))
  97       ;; Replace label-separator while maintaining cell properties.
  98       (insert label-separator)
  99       (add-text-properties pos (+ pos 2) properties)
 100       (delete-region (point) (+ (point) old-sep-len)))))
 101
 102 (defun kproperty:set (property value)
 103   "Set PROPERTY of character at point to VALUE."
 104   (kproperty:put (point) (min (+ 2 (point)) (point-max))
 105                  (list property value)))
 106
 107 ;;; kprop-em.el ends here