Mercurial > hg > xemacs-beta
diff lisp/hyperbole/kotl/kprop-em.el @ 0:376386a54a3c r19-14
Import from CVS: tag r19-14
author | cvs |
---|---|
date | Mon, 13 Aug 2007 08:45:50 +0200 |
parents | |
children |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/hyperbole/kotl/kprop-em.el Mon Aug 13 08:45:50 2007 +0200 @@ -0,0 +1,96 @@ +;;!emacs +;; +;; FILE: kprop-em.el +;; SUMMARY: Koutline text property handling under Emacs 19. +;; USAGE: GNU Emacs Lisp Library +;; KEYWORDS: outlines, wp +;; +;; AUTHOR: Bob Weiner +;; +;; ORIG-DATE: 7/27/93 +;; LAST-MOD: 30-Oct-95 at 20:59:54 by Bob Weiner +;; +;; This file is part of Hyperbole. +;; Available for use and distribution under the same terms as GNU Emacs. +;; +;; Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc. +;; Developed with support from Motorola Inc. +;; +;; DESCRIPTION: +;; DESCRIP-END. + +;;; ************************************************************************ +;;; Other required Elisp libraries +;;; ************************************************************************ + +(require 'hversion) + +;;; ************************************************************************ +;;; Public functions +;;; ************************************************************************ + +(fset 'kproperty:get 'get-text-property) + +(defun kproperty:map (function property value) + "Apply FUNCTION to each PROPERTY `eq' to VALUE in the current buffer. +FUNCTION is called with point preceding PROPERTY and receives the list of +properties at point as an argument. FUNCTION may not modify this list of +properties." + (let ((result) + (start (point-min))) + (save-excursion + (while (setq start + (text-property-any start (point-max) property value)) + (goto-char start) + (setq result (cons (funcall function (text-properties-at start)) + result)))) + (nreverse result))) + +(fset 'kproperty:next-single-change 'next-single-property-change) + +(fset 'kproperty:previous-single-change 'previous-single-property-change) + +(fset 'kproperty:properties 'text-properties-at) + +(defun kproperty:put (start end property-list &optional object) + "From START to END, add PROPERTY-LIST properties to the text. +The optional fourth argument, OBJECT, is the string or buffer containing the +text. Text inserted before or after this region does not inherit the added +properties." + (add-text-properties + start end (append property-list '(rear-nonsticky t)) object)) + +(defun kproperty:remove (start end property-list &optional object) + "From START to END, remove the text properties in PROPERTY-LIST. +The optional fourth argument, OBJECT, is the string or buffer containing the +text. PROPERTY-LIST should be a plist; if the value of a property is +non-nil, then only a property with a matching value will be removed. +Returns t if any property was changed, nil otherwise." + (let ((changed) plist property value next) + (while property-list + (setq property (car property-list) + value (car (cdr property-list)) + plist (list property value) + property-list (nthcdr 2 property-list) + next start) + (while (setq next (text-property-any next end property value object)) + (remove-text-properties next (1+ next) plist object) + (setq changed t next (1+ next)))) + changed)) + +(defun kproperty:replace-separator (pos label-separator old-sep-len) + "Replace at POS the cell label separator with LABEL-SEPARATOR. +OLD-SEP-LEN is the length of the separator being replaced." + (let (properties) + (while (setq pos (kproperty:next-single-change (point) 'kcell)) + (goto-char pos) + (setq properties (text-properties-at pos)) + ;; Replace label-separator while maintaining cell properties. + (insert label-separator) + (add-text-properties pos (+ pos 2) properties) + (delete-region (point) (+ (point) old-sep-len))))) + +(defun kproperty:set (property value) + "Set PROPERTY of character at point to VALUE." + (kproperty:put (point) (min (+ 2 (point)) (point-max)) + (list property value)))