cgit.sxemacs.org Git - packages/blob - mule-packages/lookup/lisp/lookup-utils.el

   1 ;;; lookup-utils.el --- Lookup various utilities
   2 ;; Copyright (C) 1999 Lookup Development Team <lookup@ring.gr.jp>
   3
   4 ;; Author: Keisuke Nishida <kei@psn.net>
   5 ;; Version: $Id: lookup-utils.el,v 1.2 1999/05/23 17:27:21 knishida Exp $
   6
   7 ;; This file is part of Lookup.
   8
   9 ;; Lookup is free software; you can redistribute it and/or modify it
  10 ;; under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation; either version 2 of the License, or
  12 ;; (at your option) any later version.
  13
  14 ;; Lookup is distributed in the hope that it will be useful, but
  15 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with Lookup; if not, write to the Free Software Foundation,
  21 ;; Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  22
  23 ;;; Code:
  24
  25 (require 'evi)
  26
  27 ;; alist by assq
  28
  29 (defsubst lookup-assq-ref (alist key)
  30   "Return the value associated with KEY in ALIST.
  31 This compares keys with `eq'.  See `assq'."
  32   (cdr (assq key alist)))
  33
  34 (defsubst lookup-assq-del (alist key)
  35   "Delete any entry in ALIST associated with KEY.
  36 This compares keys with `eq'.  See `assq'."
  37   (delq (assq key alist) alist))
  38
  39 (defun lookup-assq-set (alist key value)
  40   "Associate KEY in ALIST with VALUE.
  41 This compares keys with `eq'.  See `assq'."
  42   (if value
  43       (cons (cons key value) (lookup-assq-del alist key))
  44     (lookup-assq-del alist key)))
  45
  46 ;; alist by assoc
  47
  48 (defsubst lookup-assoc-ref (alist key)
  49   "Return the value associated with KEY in ALIST.
  50 This compares keys with `equal'.  See `assoc'."
  51   (cdr (assoc key alist)))
  52
  53 (defsubst lookup-assoc-del (alist key)
  54   "Delete any entry in ALIST associated with KEY.
  55 This compares keys with `equal'.  See `assoc'."
  56   (delq (assoc key alist) alist))
  57
  58 (defun lookup-assoc-set (alist key value)
  59   "Associate KEY in ALIST with VALUE.
  60 This compares keys with `equal'.  See `assoc'."
  61   (if value
  62       (cons (cons key value) (lookup-assoc-del alist key))
  63     (lookup-assoc-del alist key)))
  64
  65 ;; alist set/ref
  66
  67 (defsubst lookup-alist-ref (symbol key)
  68   "Like `lookup-assq-ref', except SYMBOL should be a symbol.
  69 SYMBOL's value must be an alist."
  70   (lookup-assq-ref (symbol-value symbol) key))
  71
  72 (defsubst lookup-alist-set (symbol key value)
  73   "Like `lookup-assq-set', except SYMBOL should be a symbol.
  74 SYMBOL's value will be modified by this function."
  75   (set symbol (lookup-assq-set (symbol-value symbol) key value)))
  76
  77 ;; multi put/get
  78
  79 (defsubst lookup-multi-put (symbol &rest args)
  80   "`put' \e$B$K;w$F$$$k$,!"G$0U$N?t$NB0@-%-!<$r<h$k$3$H$,=PMh$k!#\e(B
  81 \e$BNc$($P\e(B (lookup-multi-put SYMBOL KEY1 KEY2 VALUE) \e$B$H$$$&<0$O!"\e(B
  82 SYMBOL \e$B$K$*$1$k\e(B KEY1 \e$B$H\e(B KEY2 \e$B$H$$$&%-!<$KBP$9$kCM$H$7$F\e(B VALUE \e$B$r@_Dj$9$k!#\e(B
  83 \e$B@_Dj$5$l$?CM$O\e(B `lookup-multi-get' \e$B$K$h$j;2>H=PMh$k!#\e(B"
  84   (set symbol (lookup-multi-put-1 (symbol-value symbol) args)))
  85
  86 (defun lookup-multi-put-1 (alist args)
  87   ;; `lookup-multi-put' \e$B$NFbIt4X?t!#\e(B
  88   (if (cddr args)
  89       (lookup-assq-set alist (car args)
  90                        (lookup-multi-put-1 (lookup-assq-ref alist (car args))
  91                                            (cdr args)))
  92     (lookup-assq-set alist (car args) (cadr args))))
  93
  94 (defsubst lookup-multi-get (symbol &rest args)
  95   "`get' \e$B$K;w$F$$$k$,!"G$0U$N?t$NB0@-%-!<$r<h$k$3$H$,=PMh$k!#\e(B
  96 \e$BNc$($P\e(B (lookup-multi-put SYMBOL KEY1 KEY2) \e$B$H$$$&<0$O!"\e(B
  97 SYMBOL \e$B$K$*$1$k\e(B KEY1 \e$B$H\e(B KEY2 \e$B$H$$$&%-!<$KBP$9$kCM$r;2>H$9$k!#\e(B
  98 `lookup-multi-put' \e$B$r;2>H!#\e(B"
  99   (lookup-multi-get-1 (symbol-value symbol) args))
 100
 101 (defun lookup-multi-get-1 (alist args)
 102   ;; `lookup-multi-get' \e$B$NFbIt4X?t!#\e(B
 103   (if args
 104       (lookup-multi-get-1 (lookup-assq-ref alist (car args)) (cdr args))
 105     alist))
 106
 107 ;; misc
 108
 109 (defun lookup-repq (list from to)
 110   "LIST \e$B$NCf$G\e(B FROM \e$B$K0lCW$9$k%*%V%8%'%/%H$r\e(B TO \e$B$GCV$-49$($?%j%9%H$r@8@.$9$k!#\e(B
 111 \e$B%*%V%8%'%/%H$NHf3S$O\e(B `eq' \e$B$K$h$C$F9T$J$o$l$k!#\e(B"
 112   (let ((result nil))
 113     (while list
 114       (setq result (cons (if (eq from (car list)) to (car list)) result)
 115             list (cdr list)))
 116     (nreverse result)))
 117
 118 (defun lookup-nunique (list &optional predicate)
 119   "LIST \e$B$NCf$G=EJ#$9$k%*%V%8%'%/%H$r<h$j=|$-0l$D$K$9$k!#\e(B
 120 \e$B%*%V%8%'%/%H$NHf3S$O\e(B PREDICATE \e$B$K$h$C$F9T$J$o$l$k!#>JN,$5$l$?>l9g$K$O\e(B
 121 `equal' \e$B$,MQ$$$i$l$k!#\e(BLIST \e$B$O>e=q$-JQ99$5$l$k!#\e(B
 122
 123  (lookup-nunique '(a a b c b c a))  => (a b c)"
 124   (let ((top list) first rest)
 125     (setq predicate (or predicate 'equal))
 126     (while list
 127       (setq first (car list) rest list)
 128       (while (cdr rest)
 129         (if (funcall predicate first (cadr rest))
 130             (setcdr rest (cddr rest))
 131           (setq rest (cdr rest))))
 132       (setq list (cdr list)))
 133     top))
 134
 135 (defun lookup-foreach (function list)
 136   "LIST \e$B$NA4$F$NMWAG$KBP$7$F\e(B (funcall FUNCTION ELEMENT) \e$B$r<B9T$9$k!#\e(B
 137 `mapcar' \e$B$H;w$F$$$k$,2?$bCM$rJV$5$:!"C1$J$k7+$jJV$7$KMQ$$$k!#\e(B"
 138   (while list
 139     (funcall function (car list))
 140     (setq list (cdr list))))
 141
 142 (defun lookup-grep (predicate list)
 143   "LIST \e$B$NA4$F$NMWAG$KBP$7$F\e(B (funcall PREDICATE ELEMENT) \e$B$r<B9T$7!"\e(B
 144 non-nil \e$B$rJV$7$?$b$N$@$1$r?7$?$K%j%9%H$H$7$F@8@.$9$k!#\e(B
 145
 146  (lookup-grep 'symbolp '(1 a \"b\" c))  => (a c)"
 147   (let ((value nil))
 148     (while list
 149       (if (funcall predicate (car list))
 150           (setq value (cons (car list) value)))
 151       (setq list (cdr list)))
 152     (nreverse value)))
 153
 154 (defun lookup-map-until (predicate list)
 155   "LIST \e$B$NA4$F$NMWAG$KBP$7$F\e(B (funcall PREDICATE ELEMENT) \e$B$r<B9T$7!"\e(B
 156 \e$B:G=i$K\e(B non-nil \e$B$rJV$7$?MWAG$rJV$9!#\e(B"
 157   (let ((value nil))
 158     (while list
 159       (if (funcall predicate (car list))
 160           (setq value (car list) list nil)
 161         (setq list (cdr list))))
 162     value))
 163
 164 (defun lookup-reverse-string (string)
 165   "STRING \e$B$NA08e$N=g$rF~$lBX$($?J8;zNs$r@8@.$9$k!#\e(B"
 166   (concat (nreverse (string-to-list string))))
 167
 168 (defun lookup-oneline-string (string)
 169   "STRING \e$BFb$N2~9T$r%9%Z!<%90lJ8;z$GCV$-49$(!"0l9T$K$9$k!#\e(B"
 170   (while (string-match "\n *" string)
 171     (setq string (replace-match " " t t string)))
 172   string)
 173
 174 (defun lookup-read-string (prompt &optional init history default inherit)
 175   "`read-string' \e$B$K;w$F$$$k$,!"%*%W%7%g%s\e(B DEFAULT \e$B$,;XDj$5$l$P>l9g!"\e(B
 176 \e$B%W%m%s%W%H$K$=$NCM$r\e(B (defaut DEFAULT) \e$B$N$h$&$KI=<($9$k!#\e(BPROMPT \e$B$K$O\e(B
 177 \e$B<+F0E*$K\e(B \": \" \e$B$,IU2C$5$l$k!#\e(B"
 178   (read-string (if default
 179                    (concat prompt " (default " default "): ")
 180                  (concat prompt ": "))
 181                init history default inherit))
 182
 183 (defun lookup-map-over-property (from to prop func &optional object)
 184   "FROM \e$B$+$i\e(B TO \e$B$^$G$N%j!<%8%g%s$K$"$k3F\e(B PROP \e$B$KBP$7$F!"\e(BFUNC \e$B$r<B9T$9$k!#\e(B
 185 FUNC \e$B$O\e(B (funcall FUNC START END VALUE) \e$B$N$h$&$K8F$S=P$5$l$k!#\e(BSTART \e$B$O\e(B
 186 PROP \e$B$N3+;OCOE@!#\e(BEND \e$B$O=*N;COE@!#\e(BVALUE \e$B$O\e(B property \e$B$NCM!#\e(B
 187 \e$B%*%W%7%g%s$N\e(B OBJECT \e$B$,;XDj$5$l$F>l9g!"\e(Bcurrent-buffer \e$B$G$O$J$/\e(B OBJECT \e$B$N\e(B
 188 \e$BCf$+$i\e(B PROP \e$B$rC5$7=P$9!#\e(B"
 189   (let ((beg from) end value)
 190     (while (setq value (get-text-property beg prop object)
 191                  end (text-property-not-all beg to prop value object))
 192       (if value (funcall func beg end value))
 193       (setq beg end))
 194     (if value (funcall func beg to value))))
 195
 196 (put 'lookup-with-coding-system 'lisp-indent-function 1)
 197 (defmacro lookup-with-coding-system (coding &rest body)
 198   "\e$BF~=PNO$NJ8;z%3!<%I$r\e(B CODING \e$B$K@_Dj$7$F\e(B BODY \e$B$r<B9T$9$k!#\e(B"
 199   (` (let (;; for GNU Emacs 20 and XEmacs 20
 200            (coding-system-for-read (, coding))
 201            (coding-system-for-write (, coding))
 202            ;; for Mule 2.3
 203            (process-input-coding-system (, coding))
 204            (process-output-coding-system (, coding))
 205            (default-process-coding-system (cons (, coding) (, coding))))
 206        (,@ body))))
 207
 208 (put 'lookup-with-buffer-and-window 'lisp-indent-function 1)
 209 (defmacro lookup-with-buffer-and-window (buffer &rest body)
 210   "current-buffer \e$B$r\e(B BUFFER \e$B$K@_Dj$7!"99$K\e(B selected-window \e$B$r\e(B BUFFER \e$B$N\e(B
 211 window \e$B$K@_Dj$7$?>uBV$G\e(B BODY \e$B$r<B9T$9$k!#\e(B"
 212   (` (with-current-buffer (, buffer)
 213        (save-selected-window
 214          (if (get-buffer-window (, buffer))
 215              (select-window (get-buffer-window (, buffer)))
 216            (error "No window for buffer `%s'" (, buffer)))
 217          (,@ body)))))
 218
 219 (defun lookup-parse-table (func start end)
 220   (let ((table nil) value)
 221     (goto-char start)
 222     (while (re-search-forward " *\\([^:\n]+\\): *\\(.*\\)" end t)
 223       (if (setq value (funcall func (match-string 1) (match-string 2)))
 224           (setq table (cons value table))))
 225     (nreverse table)))
 226
 227 (defun lookup-table-insert (format args-list)
 228   (let ((format-list nil) (width-alist nil)
 229         (n 0) (start 0) (end 0) width)
 230     ;; parse format string
 231     (while (string-match "%\\(-?[0-9]*\\)." format start)
 232       (unless (eq (aref format (match-end 1)) ?%)
 233         (when (eq (aref format (match-end 1)) ?t)
 234           (setq width (string-to-number (match-string 1 format)))
 235           (lookup-alist-set 'width-alist n (cons width (abs width)))
 236           (setq format-list
 237                 (cons n (cons (substring format end (match-beginning 0))
 238                               format-list))
 239                 end (match-end 0)))
 240         (setq n (1+ n)))
 241       (setq start (match-end 0)))
 242     (setq format-list (nreverse (cons (substring format end) format-list)))
 243     ;; get max width
 244     (lookup-foreach (lambda (args)
 245                       (lookup-foreach (lambda (pair)
 246                                         (setq width (string-width
 247                                                      (nth (car pair) args)))
 248                                         (if (< (cddr pair) width)
 249                                             (setcdr (cdr pair) width)))
 250                                       width-alist))
 251                     args-list)
 252     ;; construct real format
 253     (setq format (mapconcat
 254                   (lambda (element)
 255                     (if (stringp element)
 256                         element
 257                       (let* ((pair (lookup-alist-ref 'width-alist element))
 258                              (string (if (> (car pair) 0)
 259                                          (number-to-string (cdr pair))
 260                                        (number-to-string (- (cdr pair))))))
 261                         (concat "%" string "s"))))
 262                   format-list ""))
 263     ;; insert table
 264     (while args-list
 265       (insert (apply 'format format (car args-list)))
 266       (setq args-list (cdr args-list)))))
 267
 268 ;;;
 269 ;:: Lookup current-word
 270 ;;;
 271
 272 (defun lookup-current-word (&optional strict)
 273   "\e$B%P%C%U%!$N%+!<%=%k0LCV$+$=$N<~JU$K$"$kC18l$rJ8;zNs$H$7$FJV$9!#\e(B
 274 \e$B%*%W%7%g%s$N0z?t\e(B STRICT \e$B$K\e(B non-nil \e$B$,;XDj$5$l$?>l9g!"%+!<%=%k$,C18l$H\e(B
 275 \e$B=E$J$C$F$$$k>l9g$N$_$rBP>]$H$9$k!#\e(B
 276 \e$BJQ?t\e(B `lookup-use-kakasi' \e$B$,\e(B non-nil \e$B$K;XDj$5$l$?>l9g!"F|K\8l$NC18l$b\e(B
 277 \e$B$=$l$J$j$KH=Dj$7$F@Z$j=P$9!#\e(B"
 278   (save-excursion
 279     (unless (or strict (eq (char-syntax (or (char-after (point)) 0))
 280                            (if (boundp 'MULE) ?e ?w)))
 281       (let ((syntax (if (boundp 'MULE) "^w>" "^w>")))
 282         (skip-syntax-backward syntax)
 283       (if (bolp) (skip-syntax-forward syntax) (backward-char))))
 284     (let* ((ch (or (char-after (point)) 0))
 285            ;; APEL \e$B$,Dj5A$7$F$$$k\e(B char-charset \e$B$O\e(B Emacs 20 \e$B$N$=$l$H\e(B
 286            ;; \e$BJV$jCM$,0[$J$k$N$G2sHr$9$k!#\e(B
 287            (charset (if (not (fboundp 'char-leading-char))
 288                         (char-charset ch)
 289                       (setq ch (char-leading-char ch))
 290                       (cond ((eq ch 0) 'ascii)
 291                             ((eq ch 146) 'japanese-jisx0208)
 292                             (t ch)))))
 293       (cond ((eq charset 'ascii) (lookup-current-word-ascii))
 294             ((eq charset 'japanese-jisx0208) (lookup-current-word-japanese))
 295             (t (lookup-current-word-general))))))
 296
 297 (defun lookup-current-word-general ()
 298   ;; `lookup-current-word' \e$B$NFbIt4X?t!#\e(B
 299   ;; syntax \e$B$,\e(B "w" \e$B$G$"$kJ8;z$NO"$J$j$rC18l$H$7$F@Z$j=P$9!#\e(B
 300   (buffer-substring-no-properties
 301    (progn (skip-syntax-backward "w") (point))
 302    (progn (skip-syntax-forward "w") (point))))
 303
 304 (defun lookup-current-word-ascii ()
 305   ;; `lookup-current-word' \e$B$NFbIt4X?t!#\e(B
 306   ;; \e$B%"%k%U%!%Y%C%H$"$k$$$O?t;z$NO"$J$j$rC18l$H$7$F@Z$j=P$9!#\e(B
 307   ;; \e$B$b$7C18l$NKvHx$,\e(B `-' \e$B$G$"$j!"99$K$=$l$,9TKv$G$"$k$J$i$P\e(B(\e$B$D$^$j!"\e(B
 308   ;; \e$B%9%Z%k$,6h@Z$i$l$F$$$k$h$&$J$i\e(B)\e$B!"<!$N9T$N:G=i$N%o!<%I$HO"7k$9$k!#\e(B
 309   (let ((word (buffer-substring-no-properties
 310                (progn (skip-chars-backward "a-zA-Z0-9") (point))
 311                (progn (skip-chars-forward "a-zA-Z0-9") (point)))))
 312     (if (not (looking-at "-\n"))
 313         word
 314       (forward-line)
 315       (concat word (buffer-substring-no-properties
 316                     (progn (skip-chars-forward "^a-zA-Z0-9\n") (point))
 317                     (progn (skip-chars-forward "a-zA-Z0-9") (point)))))))
 318
 319 (defun lookup-current-word-japanese ()
 320   ;; `lookup-current-word' \e$B$NFbIt4X?t!#\e(B
 321   ;; `lookup-use-kakasi' \e$B$,\e(B non-nil \e$B$K@_Dj$5$l$F$$$k>l9g!"\e(BKAKASI \e$B$rMQ$$$F\e(B
 322   ;; \e$BF|K\8l$NC18l$r$=$l$J$j$K@Z$j=P$9!#$=$&$G$J$$>l9g$O!"\e(B
 323   ;; `lookup-current-word-general' \e$B$r8F$S=P$9!#\e(B
 324   (if (not lookup-use-kakasi)
 325       (lookup-current-word-general)
 326     (let ((kakasi (if (stringp lookup-use-kakasi) lookup-use-kakasi "kakasi"))
 327           (temp-buffer (lookup-temp-buffer))
 328           (syntax (if (boundp 'MULE) "e" "w"))
 329           (start (point)) (n 1) regexp)
 330       (lookup-with-coding-system lookup-kakasi-coding-system
 331         (call-process-region
 332          (progn (skip-syntax-backward syntax) (point))
 333          (progn (skip-syntax-forward syntax) (point))
 334          kakasi nil temp-buffer nil "-w"))
 335       (with-current-buffer temp-buffer
 336         (goto-char (point-min))
 337         (while (search-forward " " nil t)
 338           (replace-match "\\)\\(" nil t))
 339         (setq regexp (concat "\\(" (buffer-string) "\\)"))
 340         (kill-buffer (current-buffer)))
 341       (re-search-backward regexp)
 342       (while (and (match-end n) (<= (match-end n) start))
 343         (setq n (1+ n)))
 344       (buffer-substring-no-properties (match-beginning n) (match-end n)))))
 345
 346 ;;;
 347 ;:: Lookup process
 348 ;;;
 349
 350 ;; Description:
 351 ;;
 352 ;; Lookup \e$B$N$$$/$D$+$N\e(B agent \e$B$,MQ$$$F$$$k%W%m%;%9A`:n4X?t!#\e(B
 353 ;; \e$B$3$l$r;H$&$3$H$OI,?\$G$O$J$$$,!"%3%^%s%I$rH/9T$7$F=PNO$r<u$1<h$k\e(B
 354 ;; \e$B$h$&$J$h$/$"$k%?%$%W$NF~=PNO$r4JN,2=$9$k$N$KJXMx!#\e(B
 355
 356 ;; Functions:
 357 ;;
 358 ;; lookup-process-require - \e$B%W%m%;%9$KJ8;zNs$rAw?.$7!"=PNO$rBT$D!#\e(B
 359 ;; lookup-process-kill - \e$B%W%m%;%9$r=*N;$9$k!#\e(B
 360
 361 (defvar lookup-process-start-point nil)
 362 (defvar lookup-process-output-value nil)
 363 (defvar lookup-process-output-filter nil)
 364 (defvar lookup-process-output-finished nil)
 365 (defvar lookup-process-output-separator nil)
 366 (defvar lookup-process-output-separator-lines 2)
 367
 368 (defun lookup-process-require (process string separator &optional filter)
 369   "PROCESS \e$B$KBP$7$F\e(B STRING \e$B$rAw$j!"$=$N=PNO$rBT$D!#\e(B
 370 \e$B=PNO=*N;$N9g?^$O!"\e(BPROCESS \e$B$,FCDj$N=*N;%3!<%I$rJV$7$?$+$I$&$+$rH=Dj$9$k\e(B
 371 \e$B$3$H$K$h$C$F9T$J$&!#\e(BSEPARATOR \e$B$K$O=*N;%3!<%I$H%^%C%A$9$k$h$&$J@55,I=8=$r\e(B
 372 \e$B;XDj$9$k!#$3$l$O;09T0J>e$K%^%C%A$9$k$h$&$J$b$N$G$"$C$F$O$J$i$J$$!#$b$7\e(B
 373 \e$B$=$l0J>e$NBg$-$5$,$"$k$J$i!"JQ?t\e(B `lookup-process-output-separator-lines'
 374 \e$B$NCM$rJQ99$9$k!#\e(B
 375 \e$B%*%W%7%g%s\e(B FILTER \e$B$,@_Dj$5$l$?>l9g!"=PNO=*N;$HF1;~$K\e(B FILTER \e$B$r8F$S=P$9!#\e(B
 376 FILTER \e$B$O\e(B (funcall FILTER PROCESS) \e$B$N$h$&$K8F$S=P$5$l$k!#$=$N$H$-$N\e(B
 377 current-buffer \e$B$O%W%m%;%9$N=PNO$,=q$-9~$^$l$?%P%C%U%!$G$"$j!"=PNOItJ,$K\e(B
 378 \e$BBP$7$F\e(B narrowing \e$B$5$l$$$k!#\e(BSEPARATOR \e$B<+BN$O\e(B narrow \e$BItJ,$K4^$^$l$J$$!#\e(B
 379 FILTER \e$B$NJV5QCM$,4X?t$NCM$H$7$FJV$5$l$k!#\e(BFILTER \e$B$O\e(B process-filter \e$B$H$7$F\e(B
 380 \e$BK\BN$H$OJL$N%9%l%C%I$G<B9T$5$l$k$N$GCm0U!#\e(BFILTER \e$B$,>JN,$5$l$?>l9g$K$O!"\e(B
 381 \e$B%W%m%;%9$N=PNO$r$=$N$^$^J8;zNs$H$7$FJV$9!#\e(B"
 382   (setq lookup-process-output-value nil)
 383   (setq lookup-process-output-filter filter)
 384   (setq lookup-process-output-finished nil)
 385   (setq lookup-process-output-separator separator)
 386   (let (temp-buffer)
 387     ;; \e$B%W%m%;%9$K%P%C%U%!$,@_Dj$5$l$F$$$k>l9g!"$=$N%P%C%U%!$r=PNO$N\e(B
 388     ;; \e$B=q$-9~$_$KMQ$$$k!#$=$&$G$J$$>l9g!"0l;~%P%C%U%!$r@8@.$9$k!#\e(B
 389     (unless (process-buffer process)
 390       (setq temp-buffer (lookup-temp-buffer))
 391       (set-process-buffer process temp-buffer))
 392     (with-current-buffer (process-buffer process)
 393       ;; FILTER \e$B4X?t$J$I$G=PNOFbMF$N=hM}Cf$K!"30;z>pJs$N3MF@$J$I$N$?$a$K\e(B
 394       ;; \e$BB?=E$K%W%m%;%9$,8F$P$l$k>l9g$,$"$k!#$=$l$rG[N8$7$F!"<B9T;~>uBV$r\e(B
 395       ;; \e$BJ];}$7$F$*$/!#\e(B[FIXME: XEmacs \e$B$G$O$&$^$/$$$+$J$$\e(B]
 396       (save-excursion
 397         (save-restriction
 398           (save-match-data
 399             (widen)
 400             (goto-char (point-max))
 401             ;; \e$BAw?.J8;zNs$r%P%C%U%!$KJ];}$7$F$+$i!"%W%m%;%9$KAw?.$9$k!#\e(B
 402             ;; \e$B$3$l$O%G%P%C%0Ey$N$H$-$KLrN)$D!#\e(B
 403             (insert string)
 404             (setq lookup-process-start-point (point))
 405             (set-process-filter process 'lookup-process-accept)
 406             (process-send-string process string)
 407             ;; \e$B=hM}$,=*$o$k$^$GBT5!$9$k!#%^%k%A%9%l%C%I$K=PMh$k$H\e(B
 408             ;; \e$B$$$$$s$@$1$I$J$!!&!&\e(B
 409             (while (not lookup-process-output-finished)
 410               (unless (accept-process-output process 5)
 411                 (with-current-buffer (process-buffer process)
 412                   (when (> (point) lookup-process-start-point)
 413                     ;; \e$B2?$i$+$N1~Ez$O$"$C$?$N$K!"$=$N8e\e(B 5 \e$BIC0J>e2?$b5/$3$i\e(B
 414                     ;; \e$B$J$+$C$?$H$7$?$i!"$?$V$s\e(B separator \e$B$N;XDj$,$*$+$7$/$F\e(B
 415                     ;; \e$B;_$^$C$F$$$k!#\e(B
 416                     (error "Lookup BUG!! Report to the mailing list")))))
 417             ;; \e$B0l;~%P%C%U%!$rMQ$$$?>l9g!"\e(Bkill-buffer \e$B$9$k!#\e(B
 418             (when temp-buffer
 419               (set-process-buffer process nil)
 420               (kill-buffer temp-buffer))))))
 421     lookup-process-output-value))
 422
 423 (defun lookup-process-accept (process string)
 424   ;; \e$B%W%m%;%9$N=PNO$r=hM}$9$k!#\e(B`lookup-process-require' \e$B$,J8;zNs$rAw?.8e!"\e(B
 425   ;; \e$B%W%m%;%9$,2?$+=PNO$rJV$9EY$K$3$N4X?t$,8F$S=P$5$l$k!#\e(B
 426   (with-current-buffer (process-buffer process)
 427     (insert string)
 428     ;; \e$B=PNO$K\e(B `lookup-process-output-separator' \e$B$,4^$^$l$F$$$k$+$I$&$+!"\e(B
 429     ;; \e$B:G8e$N?t9T$@$1%A%'%C%/$9$k!#\e(B
 430     (forward-line (- lookup-process-output-separator-lines))
 431     (if (< (point) lookup-process-start-point)
 432         (goto-char lookup-process-start-point))
 433     (when (re-search-forward lookup-process-output-separator nil 0)
 434       (goto-char (match-beginning 0))
 435       (if lookup-process-output-filter
 436           (save-current-buffer
 437             (narrow-to-region lookup-process-start-point (point))
 438             (goto-char (point-min))
 439             (setq lookup-process-output-value
 440                   (funcall lookup-process-output-filter process))
 441             (widen))
 442         (setq lookup-process-output-value
 443               (buffer-substring lookup-process-start-point (point))))
 444       (setq lookup-process-output-finished t))))
 445
 446 (defun lookup-process-kill (process)
 447   "PROCESS \e$B$r=*N;$9$k!#\e(B
 448 \e$B%W%m%;%9$K%P%C%U%!$,@_Dj$5$l$F$$$k>l9g!"$=$l$b\e(B kill-buffer \e$B$9$k!#\e(B"
 449   (delete-process process)
 450   (if (process-buffer process)
 451       (kill-buffer (process-buffer process))))
 452
 453 (provide 'lookup-utils)
 454
 455 ;;; lookup-utils.el ends here