Source

skk / skk-gadget.el

Diff from to

skk-gadget.el

 ;; $B$+$i:n$i$l$?B$8l$i$7$$!#(B
 
 ;;; Code:
-(eval-when-compile (require 'skk))
+(eval-when-compile
+  (require 'static))
+(require 'skk)
 (require 'skk-foreword)
 ;; -- user variables
 
 skk-date-ad $B$H(B skk-number-style $B$K$h$C$FI=<(J}K!$N%+%9%?%^%$%:$,2DG=!#(B"
   (interactive "*")
   (let ((start (current-time))
-        ;; Hit any key $B$H$7$?$$$H$3$m$@$,!"2?8N$+>e<j$/$f$+$J$$(B (;_;)...$B!#(B
-        ;;(now-map (if skk-emacs19
-        ;;             '(keymap (t . keyboard-quit))
-        ;;           (fillarray (make-keymap) 'keyboard-quit) ))
-        (overriding-terminal-local-map
-         (fillarray (setcar (cdr (make-keymap)) (make-vector 256 nil))
-                    'keyboard-quit ))
-        end mes expr1 expr2 )
+        end mes expr1 expr2 sec snd)
     (cond ((or (not skk-number-style)
-               (eq skk-number-style 0) )
+               (eq skk-number-style 0))
            (setq expr1 "[789]$BIC(B"
-                 expr2 "0$BIC(B" ))
+                 expr2 "0$BIC(B"))
           ((or (eq skk-number-style t)
                ;; skk-number-style $B$K(B $B?t;z$H(B t $B0J30$N(B non-nil $BCM$rF~$l$F$$$k>l(B
                ;; $B9g!"(B= $B$r;H$&$H(B Wrong type argument: number-or-marker-p, xxxx
                ;; $B$K$J$C$F$7$^$&!#(B
-               (eq skk-number-style 1) )
+               (eq skk-number-style 1))
            (setq expr1 "[$B#7#8#9(B]$BIC(B"
-                 expr2 "$B#0IC(B" ))
+                 expr2 "$B#0IC(B"))
           (t
            (setq expr1 "[$B<7H,6e(B]$BIC(B"
-                 expr2 "$B!;IC(B" )))
+                 expr2 "$B!;IC(B")))
+    ;;
+    (static-when (eq skk-emacs-type 'xemacs)
+      ;; XEmacs $B$G(B sound $B$,%m!<%I$5$l$F$$$k$+$I$&$+!#(B
+      (when (setq snd (and (boundp 'sound-alist)
+			   (eq t (catch 'tag
+				   (mapc
+				    (function
+				     (lambda (list)
+				       (and
+					(eq 'drum
+					    (cadr (memq :sound list)))
+					(throw 'tag t))))
+				    sound-alist)))))
+	;;
+	(unless (assq 'clink sound-alist)
+	  (load-sound-file "clink" 'clink))))
+    ;;
     (save-match-data
       (condition-case nil
           (let (case-fold-search
                 inhibit-quit visible-bell
                 skk-mode skk-latin-mode skk-j-mode skk-abbrev-mode
-		skk-jisx0208-latin-mode )
+		skk-jisx0208-latin-mode)
             (while (not quit-flag)
-              (setq mes (skk-current-date t))
-              (message (concat  mes "    Hit C-g quit"))
-              ;;(message (concat  mes "    Hit any key to quit"))
+              (setq mes (skk-current-date t)
+		    sec 0)
+	      (message "%s    Hit any key to quit" mes)
               (if time-signal
                   (if (string-match expr1 mes)
                       ;; [7890] $B$N$h$&$K@55,I=8=$r;H$o$:!"(B7 $B$@$1$GA4$F$N%^%7%s$,(B
                       ;; $BCe$$$F$f$1$PNI$$$N$@$,(B...$B!#CzEY$3$N4X?t<B9T;~$K(B Garbage
                       ;; collection $B$,8F$P$l$F$bI=<($5$l$k?t;z$,Ht$V>l9g$,$"$k!#(B
-                      (ding)
+		      (static-if (eq skk-emacs-type 'xemacs)
+			  ;; $B$$$$2;$,$J$$$J$!(B...
+			  (ding nil 'drum)
+			(ding))
                     (if (string-match expr2 mes)
                         ;; 0 $B$@$1!V%]!A%s!W$H$$$-$?$$$H$3$m$G$9$,!"%^%7%s$K$h$C(B
                         ;; $B$F:9$,$"$k!#(B
                         ;; $B!V%T%T%C!W$H$J$j!"2;$N%?%$%_%s%0$ONI$$$N$@$,!"$H$-(B
                         ;; $B$I$-(B 1 $BICJ,$D$$$F$$$1$J$/$J$k!#(BPentium 90Mhz +
                         ;; Mule-2.x$B$@$H!V%T%C!W$H$$$&C12;$K$J$C$F$7$^$&(B... (;_;)$B!#(B
-                        (progn (ding)(ding)) )))
-              (sit-for 1) ))
+			(static-cond
+			 ((eq skk-emacs-type 'xemacs)
+			  (if snd
+			      ;; $B$A$g$C$H$b$?$D$/(B ?
+			      (ding nil 'clink)
+			    (ding)
+			    (unless (sit-for (setq sec
+						   (+ sec
+						      (/ (float 1) (float 6))))
+					     'nodisplay)
+			      (next-command-event)
+			      (signal 'quit nil))
+			    (ding)))
+			 ((featurep 'lisp-float-type)
+			  (ding)
+			  (unless (sit-for (setq sec
+						 (+ sec
+						    (/ (float 1) (float 6))))
+					   nil
+					   'nodisplay)
+			    (next-command-event)
+			    (signal 'quit nil))
+			  (ding))
+			 (t
+			  ;; Emacs 18
+			  (ding)
+			  (ding))))))
+	      (unless (static-cond
+		       ((memq skk-emacs-type '(nemacs mule1 xemacs))
+			(sit-for (- 1 sec) 'nodisplay))
+		       (t
+			(sit-for (- 1 sec) nil 'nodisplay)))
+		(next-command-event)
+		(signal 'quit nil))))
         (quit
          (prog2
              (setq end (current-time))
              (skk-current-date t)
            (if kakutei-when-quit
-               (setq skk-kakutei-flag t) )
-           (message (format "$B7P2a;~4V(B: %s $BIC(B" (skk-time-difference start end))) ))))))
+               (setq skk-kakutei-flag t))
+           (message "$B7P2a;~4V(B: %s $BIC(B" (skk-time-difference start end))))))))
 
 ;;;###autoload
 (defun skk-ad-to-gengo (&optional fstr lstr)