[Date Prev] [Date Index] [Date Next]
[Thread Prev] [Thread Index] [Thread Next]

[xyzzy:04498] マウス右クリックメニュ



こんにちは。須田です。

メニュの話題で気が引けますけど、次の *yank-select-menu* の消し方が
わかりません。'yank-select をもっと複雑にすればたぶんいいのだろうと
思いますが、いったいどうすればいいのか、お手上げです。
よろしくお願いします。

(defun mouse-menu-popup (&optional apps)
  (interactive)
  (delete-menu *app-popup-menu* 'url)
  (delete-menu *app-popup-menu* 'url-sep)
  (delete-menu *app-popup-menu* 'yank-sep)
  (delete-menu *yank-select-menu* 'yank-select)
  (set-window *last-mouse-window*)
  (continue-pre-selection)
  (let (menu url)
	(cond ((eql (get-selection-type) 3)
		   (setq menu *app-rectangle-popup-menu*))
		  ((and (eql (get-selection-type) 2)
				(save-excursion
				  (goto-char (min (selection-point)
								  (selection-mark)))
				  (looking-at *url-scheme-regexp*)))
		   (setq url (buffer-substring (selection-point)
									   (selection-mark)))
		   (setq menu *app-popup-menu*))
		  (t
		   (setq menu *app-popup-menu*)
		   (dotimes (arg (length *kill-ring*))
			 (let ((string (car (ed::current-kill arg t))))
			   (add-menu-item *yank-select-menu* 'yank-select
							  (if (< (length string) 40)
								  string
								(substring string 0 40))
							  #'(lambda ()
								  (interactive)
								  (insert string)))))
		   (save-excursion
			 (goto-last-mouse-point)
			 (skip-chars-backward "-a-zA-Z0-9_/~.#@%?&=;+(),'$!*:")
			 (when (looking-at *url-scheme-regexp*)
			   (setq url (buffer-substring (point)
										   (progn
											 (goto-char (match-end 0))
											 (skip-chars-forward "-a-zA-Z0-9_/~.#@%?&=;+(),'$!*:")
											 (point))))))))

	(when url
	  (add-menu-separator menu 'url-sep)
	  (add-menu-item menu 'url
					 (concatenate 'string (abbreviate-display-string url 40)
								  " を開く")
					 #'(lambda ()
						 (interactive)
						 (shell-execute url t))))
	(track-popup-menu menu (or apps :button2))))


--------
須田誠也(suda seiya)
seiya.suda@xxxxxxxxxxx
http://member.nifty.ne.jp/seiya-suda/

Index Home