comparison lisp/startup.el @ 84790:e2a2c43a4876

(fancy-startup-text, fancy-about-text, fancy-startup-tail): Add help-echo to external links and to links without description. (fancy-splash-insert): Use help-echo from the 3rd element of the link specification list, or "Follow this link" if it's nil. Doc fix.

84789:cc57ea69513c

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defvar fancy-startup-text
  '((:face (variable-pitch :foreground "red")
     "Welcome to "
     :link ("GNU Emacs" (lambda (button) (browse-url "http://www.gnu.org/software/emacs/")))
     ", one component of the "
     :link
     (lambda ()
       (if (eq system-type 'gnu/linux)
	   '("GNU/Linux" (lambda (button) (browse-url "http://www.gnu.org/gnu/linux-and-gnu.html")))
	 '("GNU" (lambda (button) (describe-project)))))
     " operating system.\n"
     :face variable-pitch "To quit a partially entered command, type "
     :face default "Control-g"
     :face variable-pitch ".\n\n"
     :link ("Emacs Tutorial" (lambda (button) (help-with-tutorial)))

	     ""
	   (concat " (" title ")"))))
     "\n"
     :face variable-pitch
     :link ("Emacs Guided Tour"
	  (lambda (button) (browse-url "http://www.gnu.org/software/emacs/tour/")))
     "\tOverview of Emacs features\n"
     :link ("View Emacs Manual" (lambda (button) (info-emacs-manual)))
     "\tView the Emacs manual using Info\n"
     :link ("Absence of Warranty" (lambda (button) (describe-no-warranty)))
     "\tGNU Emacs comes with "

`:face FACE', like `fancy-splash-insert' accepts them.")

(defvar fancy-about-text
  '((:face (variable-pitch :foreground "red")
     "This is "
     :link ("GNU Emacs" (lambda (button) (browse-url "http://www.gnu.org/software/emacs/")))
     ", one component of the "
     :link
     (lambda ()
       (if (eq system-type 'gnu/linux)
	   '("GNU/Linux" (lambda (button) (browse-url "http://www.gnu.org/gnu/linux-and-gnu.html")))
	 '("GNU" (lambda (button) (describe-project)))))
     " operating system.\n"
     :face (lambda ()
	     (list 'variable-pitch :foreground
		   (if (eq (frame-parameter nil 'background-mode) 'dark)
		       "cyan" "darkblue")))

	 (if (string= en tut)
	     ""
	   (concat " (" title ")"))))
     "\n"
     :link ("Emacs Guided Tour"
	    (lambda (button) (browse-url "http://www.gnu.org/software/emacs/tour/")))
     "\tSee an overview of the many facilities of GNU Emacs"
     ))
  "A list of texts to show in the middle part of the About screen.
Each element in the list should be a list of strings or pairs
`:face FACE', like `fancy-splash-insert' accepts them.")

  "Insert text into the current buffer, with faces.
Arguments from ARGS should be either strings; functions called
with no args that return a string; pairs `:face FACE', where FACE
is a face specification usable with `put-text-property'; or pairs
`:link LINK' where LINK is a list of arguments to pass to
`insert-button', of the form (LABEL ACTION), which specifies the
button's label and `action' property.  FACE and LINK can also be
functions, which are evaluated to obtain a face or button
specification."
  (let ((current-face nil))
    (while args
      (cond ((eq (car args) :face)
	     (setq args (cdr args) current-face (car args))
	     (if (functionp current-face)

	       (if (functionp spec)
		   (setq spec (funcall spec)))
	       (insert-button (car spec)
			      'face (list 'link current-face)
			      'action (cadr spec)
			      'follow-link t)))
	    (t (insert (propertize (let ((it (car args)))
				     (if (functionp it)
					 (funcall it)
				       it))

	  (setq img (append img '(:color-symbols (("#000000" . "gray30"))))))

	;; Insert the image with a help-echo and a link.
	(make-button (prog1 (point) (insert-image img)) (point)
		     'face 'default
		     'help-echo "mouse-2: browse http://www.gnu.org/"
		     'action (lambda (button) (browse-url "http://www.gnu.org/"))
		     'follow-link t)
	(insert "\n\n")))))

(defun fancy-startup-tail (&optional concise)

    (unless concise
      (fancy-splash-insert
       :face 'variable-pitch
       "\nTo start...     "
       :link '("Open a File"
	       (lambda (button) (call-interactively 'find-file)))
       "     "
       :link '("Open Home Directory"
	       (lambda (button) (dired "~")))
       "     "
       :link '("Customize Startup"
	       (lambda (button) (customize-group 'initialization)))
       "\n"))
    (fancy-splash-insert :face `(variable-pitch :foreground ,fg)
			 "\nThis is "
			 (emacs-version)
			 "\n"

84790:e2a2c43a4876

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defvar fancy-startup-text
  '((:face (variable-pitch :foreground "red")
     "Welcome to "
     :link ("GNU Emacs"
	    (lambda (button) (browse-url "http://www.gnu.org/software/emacs/"))
	    "Browse http://www.gnu.org/software/emacs/")
     ", one component of the "
     :link
     (lambda ()
       (if (eq system-type 'gnu/linux)
	   '("GNU/Linux"
	     (lambda (button) (browse-url "http://www.gnu.org/gnu/linux-and-gnu.html"))
	     "Browse http://www.gnu.org/gnu/linux-and-gnu.html")
	 '("GNU" (lambda (button) (describe-project))
	   "Display info on the GNU project")))
     " operating system.\n"
     :face variable-pitch "To quit a partially entered command, type "
     :face default "Control-g"
     :face variable-pitch ".\n\n"
     :link ("Emacs Tutorial" (lambda (button) (help-with-tutorial)))

	     ""
	   (concat " (" title ")"))))
     "\n"
     :face variable-pitch
     :link ("Emacs Guided Tour"
	    (lambda (button) (browse-url "http://www.gnu.org/software/emacs/tour/"))
	    "Browse http://www.gnu.org/software/emacs/tour/")
     "\tOverview of Emacs features\n"
     :link ("View Emacs Manual" (lambda (button) (info-emacs-manual)))
     "\tView the Emacs manual using Info\n"
     :link ("Absence of Warranty" (lambda (button) (describe-no-warranty)))
     "\tGNU Emacs comes with "

`:face FACE', like `fancy-splash-insert' accepts them.")

(defvar fancy-about-text
  '((:face (variable-pitch :foreground "red")
     "This is "
     :link ("GNU Emacs"
	    (lambda (button) (browse-url "http://www.gnu.org/software/emacs/"))
	    "Browse http://www.gnu.org/software/emacs/")
     ", one component of the "
     :link
     (lambda ()
       (if (eq system-type 'gnu/linux)
	   '("GNU/Linux"
	     (lambda (button) (browse-url "http://www.gnu.org/gnu/linux-and-gnu.html"))
	     "Browse http://www.gnu.org/gnu/linux-and-gnu.html")
	 '("GNU" (lambda (button) (describe-project))
	   "Display info on the GNU project.")))
     " operating system.\n"
     :face (lambda ()
	     (list 'variable-pitch :foreground
		   (if (eq (frame-parameter nil 'background-mode) 'dark)
		       "cyan" "darkblue")))

	 (if (string= en tut)
	     ""
	   (concat " (" title ")"))))
     "\n"
     :link ("Emacs Guided Tour"
	    (lambda (button) (browse-url "http://www.gnu.org/software/emacs/tour/"))
	    "Browse http://www.gnu.org/software/emacs/tour/")
     "\tSee an overview of the many facilities of GNU Emacs"
     ))
  "A list of texts to show in the middle part of the About screen.
Each element in the list should be a list of strings or pairs
`:face FACE', like `fancy-splash-insert' accepts them.")

  "Insert text into the current buffer, with faces.
Arguments from ARGS should be either strings; functions called
with no args that return a string; pairs `:face FACE', where FACE
is a face specification usable with `put-text-property'; or pairs
`:link LINK' where LINK is a list of arguments to pass to
`insert-button', of the form (LABEL ACTION [HELP-ECHO]), which
specifies the button's label, `action' property and help-echo string.
FACE and LINK can also be functions, which are evaluated to obtain
a face or button specification."
  (let ((current-face nil))
    (while args
      (cond ((eq (car args) :face)
	     (setq args (cdr args) current-face (car args))
	     (if (functionp current-face)

	       (if (functionp spec)
		   (setq spec (funcall spec)))
	       (insert-button (car spec)
			      'face (list 'link current-face)
			      'action (cadr spec)
			      'help-echo (concat "mouse-2, RET: "
						 (or (nth 2 spec)
						     "Follow this link"))
			      'follow-link t)))
	    (t (insert (propertize (let ((it (car args)))
				     (if (functionp it)
					 (funcall it)
				       it))

	  (setq img (append img '(:color-symbols (("#000000" . "gray30"))))))

	;; Insert the image with a help-echo and a link.
	(make-button (prog1 (point) (insert-image img)) (point)
		     'face 'default
		     'help-echo "mouse-2, RET: Browse http://www.gnu.org/"
		     'action (lambda (button) (browse-url "http://www.gnu.org/"))
		     'follow-link t)
	(insert "\n\n")))))

(defun fancy-startup-tail (&optional concise)

    (unless concise
      (fancy-splash-insert
       :face 'variable-pitch
       "\nTo start...     "
       :link '("Open a File"
	       (lambda (button) (call-interactively 'find-file))
	       "Specify a new file's name, to edit the file")
       "     "
       :link '("Open Home Directory"
	       (lambda (button) (dired "~"))
	       "Open your home directory, to operate on its files")
       "     "
       :link '("Customize Startup"
	       (lambda (button) (customize-group 'initialization))
	       "Change initialization settings including this screen")
       "\n"))
    (fancy-splash-insert :face `(variable-pitch :foreground ,fg)
			 "\nThis is "
			 (emacs-version)
			 "\n"