Newsgroups: fj.editor.emacs
Path: galaxy.trc.rwcp.or.jp!jaist-news!cs.titech!wnoc-tyo-news!sranha!sranhd!sran230!kawabe
From: kawabe@sra.CO.JP (Yoshikatsu Kawabe)
Subject: Re: I want to use underline in egg in Nepoch
In-Reply-To: hideo@tsl.pe.u-tokyo.ac.jp's message of 2 Feb 93 11:53:59 GMT
Nntp-Posting-Host: sras48
References: <HIDEO.93Feb2205359@tsl2.tsl.pe.u-tokyo.ac.jp>
Sender: news@sran230.sra.co.jp (News System)
Organization: Software Research Associates, Inc., Japan
Date: Thu, 4 Feb 1993 03:52:29 GMT
Message-ID: <KAWABE.93Feb4125229@sras48.sra.CO.JP>
Distribution: fj
Lines: 88
Xref: galaxy.trc.rwcp.or.jp fj.editor.emacs:3469
X-originally-archived-at: http://galaxy.rwcp.or.jp/text/cgi-bin/newsarticle2?ng=fj.editor.emacs&nb=3469&hd=a
X-reformat-date: Mon, 18 Oct 2004 15:18:22 +0900
X-reformat-comment: Tabs were expanded into 4 column tabstops by the Galaxy's archiver. See http://katsu.watanabe.name/ancientfj/galaxy-format.html for more info.



>>>>> On 2 Feb 93 11:53:59 GMT,
hideo@tsl.pe.u-tokyo.ac.jp (TAKAHASHI Hideo) said:
  | 
  | contrib-3.3.2/attribute/attribute.el
  | 
  | $B$G<B8=$5$l$F$$$k4X?t$HF1L>$N4X?t$r(BNepoch$BMQ$K=q$-49$($l$PAa$$$N$+$J!)(B

    $B@N!";n$7$K:n$C$F$_$^$7$?$,!"(Bredraw $B$,$&$^$/F0$+$J$+$C$?5-21$,$"$j$^$9!#(B

------------------------------------------------------------
     Y. Kawabe @ SRA


;; epoch-attribute.el -- 
;; Author          : Yoshikatsu Kawabe
;; Created On      : Tue Apr 17 18:57:07 1990
;; Last Modified By: Yoshikatsu Kawabe
;; Last Modified On: Sat Dec  8 16:49:33 1990
;; HISTORY:
;; PURPOSE:

(provide 'attribute)

;; revese video
(defconst attribute-inverse (reserve-attribute))

(let (style)
  (setq style (epoch::make-style))
  (epoch::set-style-foreground style (epoch::background))
  (epoch::set-style-background style (epoch::foreground))
  (epoch::set-attribute-style attribute-inverse style))
  
(defconst attribute-underline (reserve-attribute))

(let (style)
  (setq style (epoch::make-style))
  (epoch::set-style-foreground style (epoch::foreground))
  (epoch::set-style-background style (epoch::background))
  (epoch::set-style-underline style (epoch::foreground))
  (epoch::set-attribute-style attribute-underline style))

(defun attribute-on-region (attr start end)
  (attribute-on-off-region attr start end t))

(defun attribute-nil-region (attr start end)
  (attribute-on-off-region attr start end nil))

(defun attribute-on-off-region (attr start end on)
  (let (attribute)
    (if (eq attr 'inverse) (setq attribute attribute-inverse))
    (if (eq attr 'underline) (setq attribute attribute-underline))
    (if attribute
(if on
    (progn
      (epoch::add-button start end attribute)
      (epoch::redisplay-screen)
      )
  (let ((attr (epoch::button-list)) p1 p2)
    (while attr
      (setq p1 (epoch::button-start (car attr))
    p2 (epoch::button-end (car attr)))
      (cond
       ((and
 (<= start p1)
 (>= end p2))
(epoch::delete-button (car attr)))
       ((and
 (<= start p1)
 (< end p2))
(epoch::delete-button (car attr))
(epoch::add-button end p2 attribute))
       ((and
 (> start p1)
 (>= end p2))
(epoch::delete-button (car attr))
(epoch::add-button start p1 attribute))
       ((and
 (> start p1)
 (< end p2))
(epoch::delete-button (car attr))
(epoch::add-button p1 start attribute)
(epoch::add-button p2 end attribute))
       )
      (setq attr (cdr attr))))
  ;;(epoch::redisplay-screen)
  ))))
