unofficial mirror of emacs-devel@gnu.org 
 help / color / mirror / code / Atom feed
* Drag-n-drop into startup fancy splash screen
@ 2006-12-23  7:37 YAMAMOTO Mitsuharu
  2006-12-24  0:33 ` Chong Yidong
  0 siblings, 1 reply; 3+ messages in thread
From: YAMAMOTO Mitsuharu @ 2006-12-23  7:37 UTC (permalink / raw)


On both X11 and Mac Carbon, drag-n-drop into the startup fancy splash
screen does not make Emacs exit from recursive editing.  That's
because the events bound in special-event-map are not handled by
fancy-splash-default-action.

How about the following patch?

				     YAMAMOTO Mitsuharu
				mituharu@math.s.chiba-u.ac.jp

Index: lisp/startup.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/startup.el,v
retrieving revision 1.423
diff -c -s -r1.423 startup.el
*** lisp/startup.el	14 Dec 2006 15:16:52 -0000	1.423
--- lisp/startup.el	23 Dec 2006 07:15:02 -0000
***************
*** 1205,1210 ****
--- 1205,1211 ----
  (defvar fancy-splash-help-echo nil)
  (defvar fancy-splash-stop-time nil)
  (defvar fancy-splash-outer-buffer nil)
+ (defvar fancy-splash-saved-special-event-sequence nil)
  
  (defun fancy-splash-insert (&rest args)
    "Insert text into the current buffer, with faces.
***************
*** 1359,1364 ****
--- 1360,1373 ----
      (push last-command-event unread-command-events))
    (throw 'exit nil))
  
+ (defun fancy-splash-save-special-event ()
+   "Save special event and stop displaying the splash screen buffer.
+ This is an internal function used to turn off the splash screen after
+ the user caused an input event that is bound in `special-event-map'"
+   (interactive)
+   (setq fancy-splash-saved-special-event-sequence (vector last-input-event))
+   (throw 'exit nil))
+ 
  
  (defun fancy-splash-screens (&optional hide-on-input)
    "Display fancy splash screens when Emacs starts."
***************
*** 1368,1373 ****
--- 1377,1383 ----
  	    splash-buffer
  	    (old-minor-mode-map-alist minor-mode-map-alist)
  	    (old-emulation-mode-map-alists emulation-mode-map-alists)
+ 	    (old-special-event-map special-event-map)
  	    (frame (fancy-splash-frame))
  	    timer)
  	(save-selected-window
***************
*** 1377,1391 ****
--- 1387,1410 ----
  	  (catch 'stop-splashing
  	    (unwind-protect
  		(let ((map (make-sparse-keymap))
+ 		      (new-special-event-map (copy-keymap special-event-map))
  		      (cursor-type nil))
  		  (use-local-map map)
  		  (define-key map [switch-frame] 'ignore)
  		  (define-key map [t] 'fancy-splash-default-action)
  		  (define-key map [mouse-movement] 'ignore)
  		  (define-key map [mode-line t] 'ignore)
+ 		  (map-keymap
+ 		   (lambda (key def)
+ 		     (unless (eq def 'ignore)
+ 		       (define-key new-special-event-map (vector key)
+ 			 'fancy-splash-save-special-event)))
+ 		   new-special-event-map)
  		  (setq display-hourglass nil
  			minor-mode-map-alist nil
  			emulation-mode-map-alists nil
+ 			special-event-map new-special-event-map
+ 			fancy-splash-saved-special-event-sequence nil
  			buffer-undo-list t
  			mode-line-format (propertize "---- %b %-"
  						     'face 'mode-line-buffer-id)
***************
*** 1399,1406 ****
  	      (cancel-timer timer)
  	      (setq display-hourglass old-hourglass
  		    minor-mode-map-alist old-minor-mode-map-alist
! 		    emulation-mode-map-alists old-emulation-mode-map-alists)
! 	      (kill-buffer splash-buffer)))))
      ;; If hide-on-input is nil, don't hide the buffer on input.
      (if (or (window-minibuffer-p)
  	    (window-dedicated-p (selected-window)))
--- 1418,1431 ----
  	      (cancel-timer timer)
  	      (setq display-hourglass old-hourglass
  		    minor-mode-map-alist old-minor-mode-map-alist
! 		    emulation-mode-map-alists old-emulation-mode-map-alists
! 		    special-event-map old-special-event-map)
! 	      (kill-buffer splash-buffer)
! 	      (if fancy-splash-saved-special-event-sequence
! 		  (command-execute
! 		   (lookup-key special-event-map
! 			       fancy-splash-saved-special-event-sequence)
! 		   nil fancy-splash-saved-special-event-sequence t))))))
      ;; If hide-on-input is nil, don't hide the buffer on input.
      (if (or (window-minibuffer-p)
  	    (window-dedicated-p (selected-window)))

^ permalink raw reply	[flat|nested] 3+ messages in thread

* Re: Drag-n-drop into startup fancy splash screen
  2006-12-23  7:37 Drag-n-drop into startup fancy splash screen YAMAMOTO Mitsuharu
@ 2006-12-24  0:33 ` Chong Yidong
  2006-12-25  8:26   ` YAMAMOTO Mitsuharu
  0 siblings, 1 reply; 3+ messages in thread
From: Chong Yidong @ 2006-12-24  0:33 UTC (permalink / raw)
  Cc: emacs-devel

YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> writes:

> On both X11 and Mac Carbon, drag-n-drop into the startup fancy splash
> screen does not make Emacs exit from recursive editing.  That's
> because the events bound in special-event-map are not handled by
> fancy-splash-default-action.
>
> How about the following patch?

Looks OK to me.

^ permalink raw reply	[flat|nested] 3+ messages in thread

* Re: Drag-n-drop into startup fancy splash screen
  2006-12-24  0:33 ` Chong Yidong
@ 2006-12-25  8:26   ` YAMAMOTO Mitsuharu
  0 siblings, 0 replies; 3+ messages in thread
From: YAMAMOTO Mitsuharu @ 2006-12-25  8:26 UTC (permalink / raw)
  Cc: emacs-devel

>>>>> On Sat, 23 Dec 2006 19:33:56 -0500, Chong Yidong <cyd@stupidchicken.com> said:

>> On both X11 and Mac Carbon, drag-n-drop into the startup fancy
>> splash screen does not make Emacs exit from recursive editing.
>> That's because the events bound in special-event-map are not
>> handled by fancy-splash-default-action.
>> 
>> How about the following patch?

> Looks OK to me.

Thanks for looking at it.  I've installed the change with some minor
modifications.

				     YAMAMOTO Mitsuharu
				mituharu@math.s.chiba-u.ac.jp

^ permalink raw reply	[flat|nested] 3+ messages in thread

end of thread, other threads:[~2006-12-25  8:26 UTC | newest]

Thread overview: 3+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2006-12-23  7:37 Drag-n-drop into startup fancy splash screen YAMAMOTO Mitsuharu
2006-12-24  0:33 ` Chong Yidong
2006-12-25  8:26   ` YAMAMOTO Mitsuharu

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).