Mercurial > hg > xemacs-beta

comparison lisp/prim/startup.el @ 30:ec9a17fef872 r19-15b98

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b98
author cvs
date Mon, 13 Aug 2007 08:52:29 +0200
parents 0293115a14e9
children e04119814345
comparison
equal deleted inserted replaced
29:7976500f47f9 30:ec9a17fef872
768 ; (set-extent-property e 'startup-presentation-hack v) 768 ; (set-extent-property e 'startup-presentation-hack v)
769 ; (set-extent-property e 'help-echo 769 ; (set-extent-property e 'help-echo
770 ; 'startup-presentation-hack-help)) 770 ; 'startup-presentation-hack-help))
771 ) 771 )
772 772
773 (defun splash-hack-version-string ()
774 (save-excursion
775 (save-restriction
776 (goto-char (point-min))
777 (re-search-forward "^XEmacs" nil t)
778 (narrow-to-region (point-at-bol) (point-at-eol))
779 (goto-char (point-min))
780 (when (re-search-forward " \\[Lucid\\]" nil t)
781 (delete-region (match-beginning 0) (match-end 0)))
782 (when (re-search-forward "[^(].*-.*-" nil t)
783 (delete-region (1+ (match-beginning 0)) (match-end 0))
784 (insert "("))
785 (goto-char (point-max))
786 (search-backward " " nil t)
787 (when (search-forward "." nil t)
788 (delete-region (1- (point)) (point-max))))))
789
773 (defun splash-frame-present (l) 790 (defun splash-frame-present (l)
774 (cond ((stringp l) 791 (cond ((stringp l)
775 (insert l)) 792 (insert l)
793 (splash-hack-version-string))
776 ((eq (car-safe l) 'face) 794 ((eq (car-safe l) 'face)
777 ;; (face name string) 795 ;; (face name string)
778 (let ((p (point))) 796 (let ((p (point)))
779 (splash-frame-present (elt l 2)) 797 (splash-frame-present (elt l 2))
780 (if (fboundp 'set-extent-face) 798 (if (fboundp 'set-extent-face)
828 (+ left-margin 846 (+ left-margin
829 (round (/ (/ (- fill-area-width glyph-pixwidth) 2) avg-pixwidth))))) 847 (round (/ (/ (- fill-area-width glyph-pixwidth) 2) avg-pixwidth)))))
830 848
831 (defun startup-splash-frame-body () 849 (defun startup-splash-frame-body ()
832 `("\n" ,(emacs-version) "\n" 850 `("\n" ,(emacs-version) "\n"
851 ,@(if (string-match "beta" emacs-version)
852 `( (face (bold blue) ( "This is an Experimental version of XEmacs."
853 "Type " (key describe-beta)
854 " to see what this means.\n")))
855 `( "\n"))
833 (face bold-italic "\ 856 (face bold-italic "\
834 Copyright (C) 1985-1996 Free Software Foundation, Inc. 857 Copyright (C) 1985-1997 Free Software Foundation, Inc.
835 Copyright (C) 1990-1994 Lucid, Inc. 858 Copyright (C) 1990-1994 Lucid, Inc.
836 Copyright (C) 1993-1996 Sun Microsystems, Inc. All Rights Reserved. 859 Copyright (C) 1993-1997 Sun Microsystems, Inc. All Rights Reserved.
837 Copyright (C) 1994-1996 Board of Trustees, University of Illinois 860 Copyright (C) 1994-1996 Board of Trustees, University of Illinois
838 Copyright (C) 1995-1996 Ben Wing\n\n") 861 Copyright (C) 1995-1996 Ben Wing\n\n")
839 862
840 ,@(if (featurep 'sparcworks) 863 ,@(if (featurep 'sparcworks)
841 `( "\ 864 `( "\