Mercurial > hg > xemacs-beta

comparison lisp/prim/startup.el @ 108:360340f9fd5f r20-1b6

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b6
author cvs
date Mon, 13 Aug 2007 09:18:39 +0200
parents c0c698873ce1
children fe104dbd9147
comparison
equal deleted inserted replaced
107:523141596bda 108:360340f9fd5f
758 ;; (set-extent-property e 'startup-presentation-hack v) 758 ;; (set-extent-property e 'startup-presentation-hack v)
759 ;; (set-extent-property e 'help-echo 759 ;; (set-extent-property e 'help-echo
760 ;; 'startup-presentation-hack-help)) 760 ;; 'startup-presentation-hack-help))
761 ) 761 )
762 762
763 (defun splash-hack-version-string ()
764 (save-excursion
765 (save-restriction
766 (goto-char (point-min))
767 (re-search-forward "^XEmacs" nil t)
768 (narrow-to-region (point-at-bol) (point-at-eol))
769 (goto-char (point-min))
770 (when (re-search-forward " \\[Lucid\\]" nil t)
771 (delete-region (match-beginning 0) (match-end 0)))
772 (when (re-search-forward "[^(].*-.*-" nil t)
773 (delete-region (1+ (match-beginning 0)) (match-end 0))
774 (insert "("))
775 (goto-char (point-max))
776 (search-backward " " nil t)
777 (when (search-forward "." nil t)
778 (delete-region (1- (point)) (point-max))))))
779
763 (defun splash-frame-present (l) 780 (defun splash-frame-present (l)
764 (cond ((stringp l) 781 (cond ((stringp l)
765 (insert l)) 782 (insert l)
783 (splash-hack-version-string))
766 ((eq (car-safe l) 'face) 784 ((eq (car-safe l) 'face)
767 ;; (face name string) 785 ;; (face name string)
768 (let ((p (point))) 786 (let ((p (point)))
769 (splash-frame-present (elt l 2)) 787 (splash-frame-present (elt l 2))
770 (if (fboundp 'set-extent-face) 788 (if (fboundp 'set-extent-face)
818 (+ left-margin 836 (+ left-margin
819 (round (/ (/ (- fill-area-width glyph-pixwidth) 2) avg-pixwidth))))) 837 (round (/ (/ (- fill-area-width glyph-pixwidth) 2) avg-pixwidth)))))
820 838
821 (defun startup-splash-frame-body () 839 (defun startup-splash-frame-body ()
822 `("\n" ,(emacs-version) "\n" 840 `("\n" ,(emacs-version) "\n"
841 ,@(if (string-match "beta" emacs-version)
842 `( (face (bold blue) ( "This is an Experimental version of XEmacs. "
843 " Type " (key describe-beta)
844 " to see what this means.\n")))
845 `( "\n"))
823 (face bold-italic "\ 846 (face bold-italic "\
824 Copyright (C) 1985-1996 Free Software Foundation, Inc. 847 Copyright (C) 1985-1997 Free Software Foundation, Inc.
825 Copyright (C) 1990-1994 Lucid, Inc. 848 Copyright (C) 1990-1994 Lucid, Inc.
826 Copyright (C) 1993-1996 Sun Microsystems, Inc. All Rights Reserved. 849 Copyright (C) 1993-1997 Sun Microsystems, Inc. All Rights Reserved.
827 Copyright (C) 1994-1996 Board of Trustees, University of Illinois 850 Copyright (C) 1994-1996 Board of Trustees, University of Illinois
828 Copyright (C) 1995-1996 Ben Wing\n\n") 851 Copyright (C) 1995-1996 Ben Wing\n\n")
829 852
830 ,@(if (featurep 'sparcworks) 853 ,@(if (featurep 'sparcworks)
831 `( "\ 854 `( "\