Changeset 3203 for trunk/lisp/international/meadow.el

Timestamp:

12/27/03 19:51:37 (5 years ago)

Author:

miyoshi

Message:

Sync up with Meadow-2.00 Beta2-dev.

Files:

• trunk/lisp/international/meadow.el (modified) (8 diffs)

trunk/lisp/international/meadow.el

@@ -22 +22 @@
-frame's display).
-
-ed
+den
-  (and (display-graphic-p display)
-       (fboundp 'image-mask-p)
@@ -28 +28 @@
-
-;; BMP support
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-;;;
@@ -53 +52 @@
-;;; overwrite splash handling
-;;;
+
+(defvar mw32-splash-masked-p nil
+  "If non-nil, show a splash screen of Meadow with a heuristic mask.")
-
-(defun use-fancy-splash-screens-p ()
@@ -67 +69 @@
-  (let* ((image-file (or fancy-splash-image
-                         "meadow.bmp"))
-
+
+
+
-         (image-width (and img (car (image-size img))))
-         (window-width (window-width (selected-window))))
@@ -78 +82 @@
-        ;; Insert the image with a help-echo and a keymap.
-        (let ((map (make-sparse-keymap))
-gnu
+meadowy
-          (define-key map [mouse-2]
-            (lambda ()
-              (interactive)
-gnu
+meadowy
-              (throw 'exit nil)))
-          (define-key map [down-mouse-2] 'ignore)
@@ -99 +103 @@
-  (insert "\n"))
-
+(defun fancy-splash-tail ()
+  "Insert the tail part of the splash screen into the current buffer."
+  (let ((fg (if (eq (frame-parameter nil 'background-mode) 'dark)
+                "cyan" "darkblue")))
+    (fancy-splash-insert :face `(variable-pitch :foreground ,fg)
+                         "\nThis is "
+                         (Meadow-version)
+                         "\n based on "
+                         (emacs-version)
+                         "\n"
+                         :face '(variable-pitch :height 0.5)
+                         "Copyright (C) 2001 Free Software Foundation, Inc.\n"
+                         "Copyright (C) 1995-2001 MIYASHITA Hisashi\n"
+                         "Copyright (C) 2002, 2003 The Meadow Team")))
-
-;;;
@@ -273 +291 @@
-(defalias 'x-file-dialog 'mw32-file-dialog)
-
+;;; Section: focus frame
+
+(defalias 'w32-focus-frame 'x-focus-frame)
+
-;;
-;; Section: Shell execute
@@ -546 +568 @@
-(defun x-display-save-under (&optional display) nil)
-
-;;;
-;;; cache for enumerated logfonts
-;;;
-(defvar w32-enum-logfont-cache-file
-  nil
-  ;; "~/.w32_enum_logfont_cache"
-  "*The cache file that contains enumerated logfonts, if it is non-nil.")
-
-(defvar w32-enum-logfont-cache nil
-  "*The cache variable that contains enumerated logfonts.")
-
-(unless (fboundp 'w32-enum-logfont-original)
-  (fset 'w32-enum-logfont-original (symbol-function 'w32-enum-logfont))
-  (defun w32-enum-logfont (&optional family device)
-    (if (or family device)
-        (w32-enum-logfont-original family device)
-      (if w32-enum-logfont-cache
-          w32-enum-logfont-cache
-        (if (null w32-enum-logfont-cache-file)
-            (setq w32-enum-logfont-cache
-                  (w32-enum-logfont-original family device))
-          (setq w32-enum-logfont-cache-file
-                (expand-file-name w32-enum-logfont-cache-file))
-          (when (file-exists-p w32-enum-logfont-cache-file)
-            (with-temp-buffer
-              (let ((coding-system-for-read 'iso-2022-7bit))
-                (insert-file-contents w32-enum-logfont-cache-file))
-              (condition-case nil
-                  (setq w32-enum-logfont-cache
-                        (read (current-buffer)))
-                (error nil)))))
-        (when (null w32-enum-logfont-cache)
-          (setq w32-enum-logfont-cache
-                (w32-enum-logfont-original family device))
-          (with-temp-buffer
-            (let ((coding-system-for-write 'iso-2022-7bit)
-                  print-level print-length)
-              (prin1 w32-enum-logfont-cache (current-buffer))
-              (write-file w32-enum-logfont-cache-file))))
-        w32-enum-logfont-cache))))
-
-(provide 'meadow)
-