Mercurial > hg > xemacs-beta
diff lisp/egg/egg-wnn.el @ 98:0d2f883870bc r20-1b1
Import from CVS: tag r20-1b1
author | cvs |
---|---|
date | Mon, 13 Aug 2007 09:13:56 +0200 |
parents | 131b0175ea99 |
children | 8619ce7e4c50 |
line wrap: on
line diff
--- a/lisp/egg/egg-wnn.el Mon Aug 13 09:12:43 2007 +0200 +++ b/lisp/egg/egg-wnn.el Mon Aug 13 09:13:56 2007 +0200 @@ -35,6 +35,8 @@ ;;; $B=$@5%a%b(B +;;; 97/2/4 Modified for use with XEmacs by J.Hein <jhod@po.iijnet.or.jp> +;;; (mostly changes regarding extents and markers) ;;; 94/2/3 kWnn support by H.Kuribayashi ;;; 93/11/24 henkan-select-kouho: bug fixed ;;; 93/7/22 hinsi-from-menu updated @@ -92,19 +94,19 @@ (defvar egg:*sho-bunsetu-face* nil "*$B>.J8@aI=<($KMQ$$$k(B face $B$^$?$O(B nil") (make-variable-buffer-local - (defvar egg:*sho-bunsetu-overlay* nil "$B>.J8@a$NI=<($K;H$&(B overlay")) + (defvar egg:*sho-bunsetu-extent* nil "$B>.J8@a$NI=<($K;H$&(B extent")) (defvar egg:*sho-bunsetu-kugiri* "-" "*$B>.J8@a$N6h@Z$j$r<($9J8;zNs(B") (defvar egg:*dai-bunsetu-face* nil "*$BBgJ8@aI=<($KMQ$$$k(B face $B$^$?$O(B nil") (make-variable-buffer-local - (defvar egg:*dai-bunsetu-overlay* nil "$BBgJ8@a$NI=<($K;H$&(B overlay")) + (defvar egg:*dai-bunsetu-extent* nil "$BBgJ8@a$NI=<($K;H$&(B extent")) (defvar egg:*dai-bunsetu-kugiri* " " "*$BBgJ8@a$N6h@Z$j$r<($9J8;zNs(B") (defvar egg:*henkan-face* nil "*$BJQ49NN0h$rI=<($9$k(B face $B$^$?$O(B nil") (make-variable-buffer-local - (defvar egg:*henkan-overlay* nil "$BJQ49NN0h$NI=<($K;H$&(B overlay")) + (defvar egg:*henkan-extent* nil "$BJQ49NN0h$NI=<($K;H$&(B extent")) (defvar egg:*henkan-open* "|" "*$BJQ49$N;OE@$r<($9J8;zNs(B") (defvar egg:*henkan-close* "|" "*$BJQ49$N=*E@$r<($9J8;zNs(B") @@ -453,6 +455,8 @@ (if (null (wnn-server-fuzokugo-set (substitute-in-file-name ffile))) (egg:error (wnn-server-get-msg)))) +;; ###jhod Currently very broken. Needs to be rewritten for the new +;; wnn-server-set-param (defun set-wnn-param (&rest param) (interactive) ; (open-wnn-if-disconnected) @@ -776,21 +780,22 @@ ;;;; (defun egg:henkan-face-on () - ;; Make an overlay if henkan overlay does not exist. - ;; Move henkan overlay to henkan region. + ;; Make an extent if henkan extent does not exist. + ;; Move henkan extent to henkan region. (if egg:*henkan-face* (progn - (if (overlayp egg:*henkan-overlay*) + (if (extentp egg:*henkan-extent*) nil - (setq egg:*henkan-overlay* (make-overlay 1 1 nil t)) - (overlay-put egg:*henkan-overlay* 'face egg:*henkan-face*)) - (move-overlay egg:*henkan-overlay* egg:*region-start* egg:*region-end*)))) + ;; ###jhod this was a 'point-type' overlay + (setq egg:*henkan-extent* (make-extent 1 1)) + (set-extent-property egg:*henkan-extent* 'face egg:*henkan-face*)) + (set-extent-endpoints egg:*henkan-extent* egg:*region-start* egg:*region-end*)))) (defun egg:henkan-face-off () - ;; detach henkan overlay from the current buffer. + ;; detach henkan extent from the current buffer. (and egg:*henkan-face* - (overlayp egg:*henkan-overlay*) - (delete-overlay egg:*henkan-overlay*) )) + (extentp egg:*henkan-extent*) + (delete-extent egg:*henkan-extent*) )) (defun henkan-region (start end) @@ -837,7 +842,7 @@ (or (markerp egg:*region-start*) (setq egg:*region-start* (make-marker))) (or (markerp egg:*region-end*) - (setq egg:*region-end* (set-marker-type (make-marker) t))) + (setq egg:*region-end* (set-marker-insertion-type (make-marker) t))) (if (null (marker-position egg:*region-start*)) (progn ;;;(setq egg:*global-map-backup* (current-global-map)) @@ -974,22 +979,22 @@ (if (or (null henkan-face) (memq henkan-face (face-list))) (progn (setq egg:*henkan-face* henkan-face) - (if (overlayp egg:*henkan-overlay*) - (overlay-put egg:*henkan-overlay* 'face egg:*henkan-face*))) + (if (extentp egg:*henkan-extent*) + (set-extent-property egg:*henkan-extent* 'face egg:*henkan-face*))) (egg:error "Wrong type of arguments(henkan-face): %s" henkan-face)) (if (or (null dai-bunsetu-face) (memq dai-bunsetu-face (face-list))) (progn (setq egg:*dai-bunsetu-face* dai-bunsetu-face) - (if (overlayp egg:*dai-bunsetu-overlay*) - (overlay-put egg:*dai-bunsetu-overlay* 'face egg:*dai-bunsetu-face*))) + (if (extentp egg:*dai-bunsetu-extent*) + (set-extent-property egg:*dai-bunsetu-extent* 'face egg:*dai-bunsetu-face*))) (egg:error "Wrong type of arguments(dai-bunsetu-face): %s" dai-bunsetu-face)) (if (or (null sho-bunsetu-face) (memq sho-bunsetu-face (face-list))) (progn (setq egg:*sho-bunsetu-face* sho-bunsetu-face) - (if (overlayp egg:*sho-bunsetu-overlay*) - (overlay-put egg:*sho-bunsetu-overlay* 'face egg:*sho-bunsetu-face*))) + (if (extentp egg:*sho-bunsetu-extent*) + (set-extent-property egg:*sho-bunsetu-extent* 'face egg:*sho-bunsetu-face*))) (egg:error "Wrong type of arguments(sho-bunsetu-face): %s" sho-bunsetu-face)) ) @@ -1123,55 +1128,60 @@ ) (defun egg:bunsetu-face-on () - ;; make dai-bunsetu overlay and sho-bunsetu overlay if they do not exist. - ;; put thier faces to overlays and move them to each bunsetu. + ;; make dai-bunsetu extent and sho-bunsetu extent if they do not exist. + ;; put thier faces to extents and move them to each bunsetu. (let* ((bunsetu-begin *bunsetu-number*) (bunsetu-end) (bunsetu-suu (wnn-server-bunsetu-suu))) ; dai bunsetu (if egg:*dai-bunsetu-face* (progn - (if (overlayp egg:*dai-bunsetu-overlay*) + (if (extentp egg:*dai-bunsetu-extent*) nil - (setq egg:*dai-bunsetu-overlay* (make-overlay 1 1)) - (overlay-put egg:*dai-bunsetu-overlay* 'face egg:*dai-bunsetu-face*)) + (setq egg:*dai-bunsetu-extent* (make-extent 1 1)) + (set-extent-property egg:*dai-bunsetu-extent* 'face egg:*dai-bunsetu-face*)) (setq bunsetu-end (wnn-server-dai-end *bunsetu-number*)) (while (not (wnn-server-dai-top bunsetu-begin)) (setq bunsetu-begin (1- bunsetu-begin))) - (move-overlay egg:*dai-bunsetu-overlay* + (set-extent-endpoints egg:*dai-bunsetu-extent* (bunsetu-position bunsetu-begin) (+ (bunsetu-position (1- bunsetu-end)) (length (bunsetu-kanji (1- bunsetu-end))))))) ; sho bunsetu (if egg:*sho-bunsetu-face* (progn - (if (overlayp egg:*sho-bunsetu-overlay*) + (if (extentp egg:*sho-bunsetu-extent*) nil - (setq egg:*sho-bunsetu-overlay* (make-overlay 1 1)) - (overlay-put egg:*sho-bunsetu-overlay* 'face egg:*sho-bunsetu-face*)) + (setq egg:*sho-bunsetu-extent* (make-extent 1 1)) + (set-extent-property egg:*sho-bunsetu-extent* 'face egg:*sho-bunsetu-face*)) (setq bunsetu-end (1+ *bunsetu-number*)) - (move-overlay egg:*sho-bunsetu-overlay* + (set-extent-endpoints egg:*sho-bunsetu-extent* (let ((point (bunsetu-position *bunsetu-number*))) +;; ###jhod Removed the char-boundary stuff, as I *THINK* we can only move by whole chars... +;; (if (eq egg:*sho-bunsetu-face* 'modeline) +;; (+ point (1+ (char-boundary-p point))) +;; point)) (if (eq egg:*sho-bunsetu-face* 'modeline) - (+ point (1+ (char-boundary-p point))) + (+ point 1) point)) + (+ (bunsetu-position (1- bunsetu-end)) (length (bunsetu-kanji (1- bunsetu-end))))))))) (defun egg:bunsetu-face-off () (and egg:*dai-bunsetu-face* - (overlayp egg:*dai-bunsetu-overlay*) - (delete-overlay egg:*dai-bunsetu-overlay*)) + (extentp egg:*dai-bunsetu-extent*) + (delete-extent egg:*dai-bunsetu-extent*)) (and egg:*sho-bunsetu-face* - (overlayp egg:*sho-bunsetu-overlay*) - (delete-overlay egg:*sho-bunsetu-overlay*)) + (extentp egg:*sho-bunsetu-extent*) + (delete-extent egg:*sho-bunsetu-extent*)) ) (defun henkan-goto-bunsetu (number) (setq *bunsetu-number* (check-number-range number 0 (1- (wnn-server-bunsetu-suu)))) (goto-char (bunsetu-position *bunsetu-number*)) -; (egg:move-bunsetu-overlay) +; (egg:move-bunsetu-extent) (egg:bunsetu-face-on) ) @@ -1259,7 +1269,7 @@ (goto-char (bunsetu-position min)) (henkan-insert-kouho min max) (goto-char point)) -; (egg:move-bunsetu-overlay) +; (egg:move-bunsetu-extent) (egg:bunsetu-face-on) (egg:henkan-face-on) )