;;;
-;;; $Id: tl-nemacs.el,v 1.2 1994/10/20 00:37:15 morioka Exp $
+;;; $Id: tl-nemacs.el,v 2.0 1994/10/29 18:31:55 morioka Exp $
;;;
(provide 'tl-nemacs)
(if (< chr 128)
lc-ascii
lc-jp))
+
+
+;; by YAMATE Keiichirou 1994/10/28
+(defun attribute-add-narrow-attribute (attr from to)
+ (or (consp (symbol-value attr))
+ (set attr (list 1)))
+ (let* ((attr-value (symbol-value attr))
+ (len (car attr-value))
+ (posfrom 1)
+ posto)
+ (while (and (< posfrom len)
+ (> from (nth posfrom attr-value)))
+ (setq posfrom (1+ posfrom)))
+ (setq posto posfrom)
+ (while (and (< posto len)
+ (> to (nth posto attr-value)))
+ (setq posto (1+ posto)))
+ (if (= posto posfrom)
+ (if (= (% posto 2) 1)
+ (if (and (< to len)
+ (= to (nth posto attr-value)))
+ (set-marker (nth posto attr-value) from)
+ (setcdr (nthcdr (1- posfrom) attr-value)
+ (cons (set-marker-type (set-marker (make-marker)
+ from)
+ 'point-type)
+ (cons (set-marker-type (set-marker (make-marker)
+ to)
+ nil)
+ (nthcdr posto attr-value))))
+ (setcar attr-value (+ len 2))))
+ (if (= (% posfrom 2) 0)
+ (setq posfrom (1- posfrom))
+ (set-marker (nth posfrom attr-value) from))
+ (if (= (% posto 2) 0)
+ nil
+ (setq posto (1- posto))
+ (set-marker (nth posto attr-value) to))
+ (setcdr (nthcdr posfrom attr-value)
+ (nthcdr posto attr-value)))))