Mercurial > hg > xemacs-beta

changeset 2505:3e5a2d0d57e1

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2005-01-26 04:56:17 by ben] The splash screen change startup.el: Rename "splash-frame" -> "splash-screen" (its change long ago from screen to frame happened during the general screen->frame sub and was a mistake). Compress all info onto one screen rather than cycling through 3 of them. Update copyright years and some other random stuff. menubar-items.el: Removed. frame->screen and rewrite to fix bugginess. Add menu items for beta and distribution info.
author ben
date Wed, 26 Jan 2005 04:56:18 +0000
parents e17beacca645
children 8c96bdabcaf9
files lisp/ChangeLog lisp/menubar-items.el lisp/startup.el
diffstat 3 files changed, 173 insertions(+), 201 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Wed Jan 26 04:47:14 2005 +0000
+++ b/lisp/ChangeLog	Wed Jan 26 04:56:18 2005 +0000
@@ -1,3 +1,39 @@
+2005-01-25  Ben Wing  <ben@xemacs.org>
+
+	* startup.el:
+	* startup.el (splash-frame-timeout): Removed.
+	* startup.el (command-line-1):
+	* startup.el (startup-presentation-hack-keymap): Removed.
+	* startup.el (startup-presentation-hack-help):
+	* startup.el (startup-presentation-hack): Removed.
+	* startup.el (splash-frame-present): Removed.
+	* startup.el (splash-screen-present): New.
+	* startup.el (splash-frame-present-hack): Removed.
+	* startup.el (startup-presentation-activate): New.
+	* startup.el (splash-screen-present-hack): New.
+	* startup.el (startup-center-spaces):
+	* startup.el (splash-frame-body): Removed.
+	* startup.el (splash-screen-window-body): New.
+	* startup.el (splash-screen-tty-body): New.
+	* startup.el (splash-frame-static-body): Removed.
+	* startup.el (circulate-splash-frame-elements): Removed.
+	* startup.el (display-splash-frame): Removed.
+	* startup.el (splash-screen-static-body): New.
+	* startup.el ('splash-frame-static-body): New.
+	* startup.el (display-splash-screen): New.
+	* startup.el (xemacs-splash-buffer): New.
+	Rename "splash-frame" -> "splash-screen" (its change
+	long ago from screen to frame happened during the general
+	screen->frame sub and was a mistake).	Compress all info
+	onto one screen rather than cycling through 3 of them.
+	Update copyright years and some other random stuff.
+
+	* menubar-items.el:
+	* menubar-items.el (default-menubar):
+	* menubar-items.el (xemacs-splash-buffer): Removed.
+	frame->screen and rewrite to fix bugginess.
+	Add menu items for beta and distribution info.
+
 2005-01-25  Ben Wing  <ben@xemacs.org>
 
 	* mouse.el:
@@ -12,40 +48,6 @@
 	activation that is only triggered by button2 or button1 double-click
 	and a regular activation also triggered by button1.
 
-2004-11-01  Ben Wing  <ben@xemacs.org>
-
-	* menubar-items.el (xemacs-splash-buffer):
-	frame->screen and rewrite to fix bugginess.
-
-	* startup.el:
-	* startup.el (splash-frame-timeout): Removed.
-	* startup.el (splash-screen-timeout): New.
-	* startup.el (splash-screen-circulate): New.
-	* startup.el (command-line-1):
-	* startup.el (splash-frame-present-hack): Removed.
-	* startup.el (splash-screen-present-hack): New.
-	* startup.el (splash-frame-present): Removed.
-	* startup.el (splash-screen-present): New.
-	* startup.el (splash-frame-body): Removed.
-	* startup.el (splash-screen-body): New.
-	* startup.el (splash-frame-static-body): Removed.
-	* startup.el (splash-screen-static-body): New.
-	* startup.el ('splash-frame-static-body): New.
-	* startup.el (circulate-splash-frame-elements): Removed.
-	* startup.el (circulate-splash-screen-elements): New.
-	* startup.el (display-splash-frame): Removed.
-	* startup.el (display-splash-screen): New.
-	Rename "splash-frame" -> "splash-screen" (its change
-	long ago from screen to frame happened during the general
-	screen->frame sub and was a mistake).  Provide obsolete
-	compatibility var for existing locale .el files.
-	Change so that it no longer automatically cycles every 7
-	seconds or so -- instead, it lets you cycle yourself by
-	pressing `n', or any other key to clear (and displays
-	a message stating this).  Update copyright years and some
-	other random stuff.  New variable splash-screen-circulate
-	which can be set (sufficiently early) to get the old behavior.
-
 2005-01-25  Ben Wing  <ben@xemacs.org>
 
 	* font-lock.el (c-font-lock-keywords-2): Removed.
--- a/lisp/menubar-items.el	Wed Jan 26 04:47:14 2005 +0000
+++ b/lisp/menubar-items.el	Wed Jan 26 04:56:18 2005 +0000
@@ -1619,6 +1619,8 @@
       ["%_Home Page (www.xemacs.org)" xemacs-www-page
        :active (fboundp 'browse-url)]
       ["What's %_New in XEmacs" view-emacs-news]
+      ["B%_eta Info" describe-beta
+	:included (string-match "beta" emacs-version)]
       "-----"
       ("%_Info (Online Docs)"
        ["%_Info Contents" (Info-goto-node "(dir)")]
@@ -1702,6 +1704,7 @@
       ("%_Other"
        ["%_Current Installation Info" describe-installation
 	:active (boundp 'Installation-string)]
+       ["%_Obtaining the Latest Version" describe-distribution]
        ["%_No Warranty" describe-no-warranty]
        ["XEmacs %_License" describe-copying]
        ["Find %_Packages" finder-by-keyword]
@@ -2107,27 +2110,6 @@
 (setq-default mode-popup-menu default-popup-menu)
 
 
-;; misc
-
-(defun xemacs-splash-buffer ()
-  "Redisplay XEmacs splash screen in a buffer."
-  (interactive)
-  (let ((buffer (get-buffer-create "*Splash*"))
-	tmout)
-    (set-buffer buffer)
-    (setq buffer-read-only t)
-    (erase-buffer buffer)
-    (setq tmout (display-splash-frame))
-    (when tmout
-      (make-local-hook 'kill-buffer-hook)
-      (add-hook 'kill-buffer-hook
-		`(lambda ()
-		   (disable-timeout ,tmout))
-		nil t))
-    (pop-to-buffer buffer)
-    (delete-other-windows)))
-
-
 ;;; backwards compatibility
 (provide 'x-menubar)
 (provide 'menubar-items)
--- a/lisp/startup.el	Wed Jan 26 04:47:14 2005 +0000
+++ b/lisp/startup.el	Wed Jan 26 04:56:18 2005 +0000
@@ -3,7 +3,7 @@
 ;; Copyright (C) 1985-1986, 1990, 1992-1997 Free Software Foundation, Inc.
 ;; Copyright (c) 1993, 1994 Sun Microsystems, Inc.
 ;; Copyright (C) 1995 Board of Trustees, University of Illinois
-;; Copyright (C) 2001, 2002, 2003 Ben Wing.
+;; Copyright (C) 2001, 2002, 2003, 2004, 2005 Ben Wing.
 
 ;; Maintainer: XEmacs Development Team
 ;; Keywords: internal, dumped
@@ -72,7 +72,6 @@
 (defvar command-line-processed nil "t once command line has been processed")
 
 (defconst startup-message-timeout 12000) ; More or less disable the timeout
-(defconst splash-frame-timeout 7) ; interval between splash frame elements
 
 (defconst inhibit-startup-message nil
   "*Non-nil inhibits the initial startup message.
@@ -1059,7 +1058,7 @@
       (when (string= (buffer-name) "*scratch*")
 	(unless (or inhibit-startup-message
 		    (input-pending-p))
-	  (let (tmout circ-tmout)
+	  (let (tmout)
 	    (unwind-protect
 		;; Guts of with-timeout
 		(catch 'tmout
@@ -1069,13 +1068,12 @@
 						 (throw 'tmout t)
 					       (error nil)))
 					   nil))
-		  (setq circ-tmout (display-splash-frame))
+		  (display-splash-screen)
 		  (or nil;; (pos-visible-in-window-p (point-min))
 		      (goto-char (point-min)))
 		  (sit-for 0)
 		  (setq unread-command-event (next-command-event)))
-	      (when tmout (disable-timeout tmout))
-	      (when circ-tmout (disable-timeout circ-tmout)))))
+	      (when tmout (disable-timeout tmout)))))
 	(with-current-buffer (get-buffer "*scratch*")
 	  ;; In case the XEmacs server has already selected
 	  ;; another buffer, erase the one our message is in.
@@ -1125,55 +1123,20 @@
 	    (goto-line line)
 	    (setq line nil))))))))
 
-(defvar startup-presentation-hack-keymap
-  (let ((map (make-sparse-keymap)))
-    (set-keymap-name map 'startup-presentation-hack-keymap)
-    (define-key map '[button1] 'startup-presentation-hack)
-    (define-key map '[button2] 'startup-presentation-hack)
-    map)
-  "Putting yesterday in the future tomorrow.")
-
-(defun startup-presentation-hack ()
-  (interactive)
-  (let ((e last-command-event))
-    (and (button-press-event-p e)
-         (setq e (extent-at (event-point e)
-                            (event-buffer e)
-                            'startup-presentation-hack))
-         (setq e (extent-property e 'startup-presentation-hack))
-         (if (consp e)
-             (apply (car e) (cdr e))
-	   (while (keymapp (indirect-function e))
-	     (let ((map e)
-		   (overriding-local-map (indirect-function e)))
-	       (setq e (read-key-sequence
-			(let ((p (keymap-prompt map t)))
-			  (cond ((symbolp map)
-				 (if p
-				     (format "%s %s " map p)
-				   (format "%s " map)))
-				(p)
-				(t
-				 (prin1-to-string map))))))
-	       (if (and (button-release-event-p (elt e 0))
-			(null (key-binding e)))
-		   (setq e map)		; try again
-		 (setq e (key-binding e)))))
-	   (call-interactively e)))))
-
+
 (defun startup-presentation-hack-help (e)
   (setq e (extent-property e 'startup-presentation-hack))
-  (if (consp e)
-      (format "Evaluate %S" e)
-    (symbol-name e)))
+  (symbol-name e))
+
+(defun startup-presentation-activate (ev ex)
+  (call-interactively (extent-property ex 'startup-presentation-hack)))
 
-(defun splash-frame-present-hack (e v)
-  ;;   (set-extent-property e 'mouse-face 'highlight)
-  ;;   (set-extent-property e 'keymap
-  ;;    		       startup-presentation-hack-keymap)
-  ;;   (set-extent-property e 'startup-presentation-hack v)
-  ;;   (set-extent-property e 'help-echo
-  ;;    		       'startup-presentation-hack-help)
+(defun splash-screen-present-hack (e v)
+;   (set-extent-property e 'mouse-face 'highlight)
+;   (set-extent-property e 'startup-presentation-hack v)
+;   (set-extent-property e 'help-echo
+;     		       'startup-presentation-hack-help)
+;   (set-extent-property e 'activate-function 'startup-presentation-activate)
   )
 
 (defun splash-hack-version-string ()
@@ -1193,35 +1156,34 @@
       (when (search-forward "." nil t)
 	(delete-region (1- (point)) (point-max))))))
 
-(defun splash-frame-present (l)
+;; parse one page description (see `splash-screen-body') and display
+;; at point.
+(defun splash-screen-present (l)
   (cond ((stringp l)
          (insert l))
         ((eq (car-safe l) 'face)
          ;; (face name string)
          (let ((p (point)))
-           (splash-frame-present (elt l 2))
-           (if (fboundp 'set-extent-face)
-               (set-extent-face (make-extent p (point))
-                                (elt l 1)))))
+           (splash-screen-present (elt l 2))
+	   (set-extent-face (make-extent p (point))
+			    (elt l 1))))
         ((eq (car-safe l) 'key)
          (let* ((c (elt l 1))
                 (p (point))
                 (k (where-is-internal c nil t)))
            (insert (if k (key-description k)
 		     (format "M-x %s" c)))
-           (if (fboundp 'set-extent-face)
-               (let ((e (make-extent p (point))))
-                 (set-extent-face e 'bold)
-                 (splash-frame-present-hack e c)))))
+	   (let ((e (make-extent p (point))))
+	     (set-extent-face e 'bold)
+	     (splash-screen-present-hack e c))))
         ((eq (car-safe l) 'funcall)
          ;; (funcall (fun . args) string)
          (let ((p (point)))
-           (splash-frame-present (elt l 2))
-           (if (fboundp 'set-extent-face)
-               (splash-frame-present-hack (make-extent p (point))
-					  (elt l 1)))))
+           (splash-screen-present (elt l 2))
+	   (splash-screen-present-hack (make-extent p (point))
+				       (elt l 1))))
 	((consp l)
-	 (mapcar 'splash-frame-present l))
+	 (mapcar 'splash-screen-present l))
         (t
          (error "WTF!?"))))
 
@@ -1241,9 +1203,6 @@
 	 (fill-area-width  (* avg-pixwidth (- fill-column left-margin)))
 	 (glyph-pixwidth   (cond ((stringp glyph)
 				  (* avg-pixwidth (length glyph)))
-				 ;; #### the pixmap option should be removed
-				 ;;((pixmapp glyph)
-				 ;; (pixmap-width glyph))
 				 ((glyphp glyph)
 				  (glyph-width glyph))
 				 (t
@@ -1251,10 +1210,49 @@
     (+ left-margin
        (round (/ (/ (- fill-area-width glyph-pixwidth) 2) avg-pixwidth)))))
 
-(defun splash-frame-body ()
-  `[((face (blue bold underline)
-	   "\nDistribution, copying license, warranty:\n\n")
-     "Please visit the XEmacs website at http://www.xemacs.org/ !\n\n"
+;; the splash screen originated in 19.10 as splash-screen-*.  When
+;; Chuck made the global screen->frame change for 19.12, he
+;; accidentally changed these too.  This randomness is getting on my
+;; nerves, so let's fix it and provide minimal aliases for the
+;; `locale' mule package. --ben
+
+;; returns either of vector of page descriptions, each describing one
+;; screenful of information, or just one such page descriptions  Each
+;; page description is a list of textual elements describing how to
+;; display a section of text.  The elements are processed in turn and
+;; the results inserted one after the previous in a buffer.  Each
+;; textual element is either:
+
+;; -- a string, inserted as-is with no decoration.
+;; -- a list of (face FACES "text"), where FACES is the name of a face
+;;    or a list of such names, and specifies the face(s) used when
+;;    displaying the text.
+;; -- a list of (key COMMAND-NAME); the key sequence corresponding to
+;;    the command will be inserted, in boldface.
+;; -- a list of textual elements.
+
+(defun splash-screen-window-body ()
+  `(
+     (face (blue bold underline)
+	   "Useful Help-menu entries:\n\n")
+     ,@(if (string-match "beta" emacs-version)
+	   `((face bold "Beta Info:")
+	     (face (red bold)
+		   "                      This is an Experimental version of XEmacs.\n"))
+	 `( ""))
+     (face bold "XEmacs FAQ:")
+     "                     Read the XEmacs FAQ.\n"
+     (face bold "Info (Online Docs):")
+     "             Read the on-line documentation.\n"
+     (face bold "Tutorial:")
+     "                       XEmacs tutorial.\n"
+     (face bold "Samples->View Sample init.el:")
+     "   A useful initialization file.\n"
+     (face bold "About XEmacs:")
+     "                   See who's developing XEmacs.\n"
+     "\n"
+     (face (bold blue) "XEmacs website:")
+     "                 http://www.xemacs.org/\n\n"
      ,@(if (featurep 'sparcworks)
 	   `( "\
 Sun provides support for the WorkShop/XEmacs integration package only.
@@ -1263,8 +1261,6 @@
 				(getenv "LANG"))))
 		  (if (and
 		       (not (featurep 'mule)) ;; Already got mule?
-		       ;; No Mule support on tty's yet
-		       (not (eq 'tty (console-type)))
 		       lang ;; Non-English locale?
 		       (not (string= lang "C"))
 		       (not (string-match "^en" lang))
@@ -1276,46 +1272,47 @@
 XEmacs, by either running the command `xemacs-mule', or by using the X resource
 `ESERVE*defaultXEmacsPath: xemacs-mule' when starting XEmacs from Sun WorkShop.
 \n")))))
-     ((key describe-no-warranty)
-      ": "(face (red bold) "XEmacs comes with ABSOLUTELY NO WARRANTY\n"))
-     ((key describe-copying)
-      ": conditions to give out copies of XEmacs\n")
-     ((key describe-distribution)
-      ": how to get the latest version\n")
-     "\n--\n"
      (face italic "\
 Copyright (C) 1985-1999 Free Software Foundation, Inc.
 Copyright (C) 1990-1994 Lucid, Inc.
 Copyright (C) 1993-1997 Sun Microsystems, Inc. All Rights Reserved.
-Copyright (C) 1994-1996 Board of Trustees, University of Illinois
-Copyright (C) 1995-1996 Ben Wing\n"))
+Copyright (C) 1994-1996 Board of Trustees, University of Illinois.
+Copyright (C) 1995-2005 Ben Wing.\n")
+     ))
 
-    ((face (blue bold underline) "\nInformation, on-line help:\n\n")
-     "XEmacs comes with plenty of documentation...\n\n"
+(defun splash-screen-tty-body ()
+  `(
+    (face italic "[`C-' means the control key, `M-' means the meta key]\n\n")
      ,@(if (string-match "beta" emacs-version)
 	   `((key describe-beta)
 	     ": " (face (red bold)
 			"This is an Experimental version of XEmacs.\n"))
 	 `( "\n"))
      ((key xemacs-local-faq)
-      ": read the XEmacs FAQ (a " (face underline "capital") " F!)\n")
-     ((key help-with-tutorial)
-      ": read the XEmacs tutorial (also available through the "
-      (face bold "Help") " menu)\n")
+      ": Read the XEmacs FAQ. (A " (face underline "capital") " F!)\n")
+     ((key info) ": Read the on-line documentation.\n")
      ((key help-command)
-      ": get help on using XEmacs (also available through the "
-      (face bold "Help") " menu)\n")
-     ((key info) ": read the on-line documentation\n\n")
-     ((key describe-project) ": read about the GNU project\n")
-     ((key about-xemacs) ": see who's developing XEmacs\n"))
-
-    ((face (blue bold underline) "\nUseful stuff:\n\n")
-     "Things that you should learn rather quickly...\n\n"
-     ((key find-file) ": visit a file\n")
-     ((key save-buffer) ": save changes\n")
-     ((key undo) ": undo changes\n")
-     ((key save-buffers-kill-emacs) ": exit XEmacs\n"))
-    ])
+      ": Get help on using XEmacs.\n")
+     ((key help-with-tutorial)
+      ": Read the XEmacs tutorial.\n")
+     ((key view-sample-init-el)
+      ": View the sample init.el file.\n")
+     ((key about-xemacs) ": See who's developing XEmacs.\n")
+     ((key save-buffers-kill-emacs)
+      ": exit XEmacs\n")
+     "\n"
+     (face (bold blue) "XEmacs website: ") 
+     "http://www.xemacs.org/\n\n"
+     (face italic "\
+Copyright (C) 1985-1999 Free Software Foundation, Inc.
+Copyright (C) 1990-1994 Lucid, Inc.
+Copyright (C) 1993-1997 Sun Microsystems, Inc. All Rights Reserved.
+Copyright (C) 1994-1996 Board of Trustees, University of Illinois.
+Copyright (C) 1995-2004 Ben Wing.")
+;      ((key find-file) ": visit a file; ")
+;      ((key save-buffer) ": save changes; ")
+;      ((key undo) ": undo changes; ")
+     ))
 
 ;; I really hate global variables, oh well.
 ;(defvar xemacs-startup-logo-function nil
@@ -1323,67 +1320,58 @@
 ;This function should return an initialized glyph if it is used.")
 
 ;; This will hopefully go away when gettext is functional.
-(defconst splash-frame-static-body
-  `(,(emacs-version) "\n\n"
-    (face italic "`C-' means the control key,`M-' means the meta key\n\n")))
-
+(defconst splash-screen-static-body
+  `(,(emacs-version) "\n\n"))
+;; temporary support for old locale files.
+(define-obsolete-variable-alias 'splash-frame-static-body
+  'splash-screen-static-body)
 
-(defun circulate-splash-frame-elements (client-data)
-  (with-current-buffer (aref client-data 2)
-    (let ((buffer-read-only nil)
-	  (elements (aref client-data 3))
-	  (indice (aref client-data 0)))
-      (goto-char (aref client-data 1))
-      (delete-region (point) (point-max))
-      (splash-frame-present (aref elements indice))
-      (set-buffer-modified-p nil)
-      (aset client-data 0
-	    (if (= indice (- (length elements) 1))
-		0
-	      (1+ indice )))
-      )))
-
-;; #### This function now returns the (possibly nil) timeout circulating the
-;; splash-frame elements
-(defun display-splash-frame ()
+(defun display-splash-screen ()
+  ;; display the splash screen in the current buffer and put it in the
+  ;; current window.
   (let ((logo xemacs-logo)
 	(buffer-read-only nil)
-        (cramped-p (eq 'tty (console-type))))
-    (unless cramped-p (insert "\n"))
-    (indent-to (startup-center-spaces logo))
-    (set-extent-begin-glyph (make-extent (point) (point)) logo)
-    ;;(splash-frame-present-hack (make-extent p (point)) 'about-xemacs))
-    (insert "\n\n")
-    (splash-frame-present splash-frame-static-body)
+        (tty (eq 'tty (console-type))))
+    (unless tty
+      (insert "\n")
+      (indent-to (startup-center-spaces logo))
+      (set-extent-begin-glyph (make-extent (point) (point)) logo)
+      ;;(splash-screen-present-hack (make-extent p (point)) 'about-xemacs))
+      (insert "\n\n"))
+    (splash-screen-present splash-screen-static-body)
     (splash-hack-version-string)
     (goto-char (point-max))
     (let* ((after-change-functions nil) ; no font-lock, thank you
-	   (elements (splash-frame-body))
-	   (client-data `[ 1 ,(point) ,(current-buffer) ,elements ])
-	   tmout)
-      (if (listp  elements) ;; A single element to display
-	  (splash-frame-present (splash-frame-body))
-	;; several elements to rotate
-	(splash-frame-present (aref elements 0))
-	(setq tmout (add-timeout splash-frame-timeout
-				 'circulate-splash-frame-elements
-				 client-data splash-frame-timeout)))
-      (set-buffer-modified-p nil)
-      tmout)))
+	   (elements (cond (tty (splash-screen-tty-body))
+			   (t (splash-screen-window-body)))))
+      (pop-to-buffer (current-buffer))
+      (delete-other-windows)
+      (splash-screen-present elements)
+      (set-buffer-modified-p nil))))
+
+(defun xemacs-splash-buffer ()
+  "Display XEmacs splash screen in a buffer."
+  (interactive)
+  (let ((buffer (get-buffer-create "*Splash*")))
+    (set-buffer buffer)
+    (setq buffer-read-only nil)
+    (erase-buffer buffer)
+    (display-splash-screen)))
 
 ;;  (let ((present-file
 ;;         #'(lambda (f)
-;;             (splash-frame-present
+;;             (splash-screen-present
 ;;	      (list 'funcall
 ;;		    (list 'find-file-other-window
 ;;			  (expand-file-name f data-directory))
 ;;		    f)))))
 ;;    (insert "For customization examples, see the files ")
-;;    (funcall present-file "sample.emacs")
+;;    (funcall present-file "sample.init.el")
 ;;    (insert " and ")
 ;;    (funcall present-file "sample.Xresources")
 ;;    (insert (format "\nin the directory %s." data-directory)))
 
+
 (defun startup-set-invocation-environment ()
   ;; XEmacs -- Steven Baur says invocation directory is nil if you
   ;; try to use XEmacs as a login shell.