From: Katsumi Yamaoka <yamaoka@jpl.org>
To: ding@gnus.org
Cc: emacs-w3m@namazu.org
Subject: [emacs-w3m:11213] Re: right clicking on URL in emacs-w3m vs. gnus
Date: Wed, 21 Apr 2010 15:08:26 +0900 [thread overview]
Message-ID: <b4mwrw149t1.fsf@jpl.org> (raw)
In-Reply-To: <87sk6qf3bu.fsf@lifelogs.com>
[-- Attachment #1: Type: text/plain, Size: 1824 bytes --]
>>>>> Ted Zlatanov wrote:
> On Sun, 18 Apr 2010 06:41:23 +0800 jidanni@jidanni.org wrote:
j> In emacs-w3m, right clicking on a link brings up a menu with lots of choices.
j> However doing the same action inside gnus doesn't.
j> E.g., try right clicking on http://example.org/ .
> This is composed of two things actually:
> 1) the emacs-w3m popup menu should be accessible in the Article buffer.
> Currently it can be invoked with (w3m-mouse-major-mode-menu EVENT) so it
> *can* be bound to right-click in the article mode by the user. This
> part is pretty easy.
> 2) right-click on a URL should bring up that menu. I'm not sure if
> there are any other logical things to hang on right-click in Gnus. For
> instance we could bring up the Treatment or Commands menus that are
> otherwise in the pulldown. So maybe the emacs-w3m menu should be under
> the main popup menu in the article buffer, and it should also show up in
> the menu bar when the article buffer is using emacs-w3m.
> Any opinions?
I don't know what items the menu should provide but I tried hacking
it as attached below. Currently the right-click pops up this menu:
,----
| Open this link with
| ===================
| browse-url
| emacs-w3m
`----
(The first item overlaps to the middle-click though.)
2010-04-21 Katsumi Yamaoka <yamaoka@jpl.org>
* gnus-art.el (gnus-article-add-buttons): Add url string as text
property to button.
(gnus-article-extend-url-button): Use text property instead of overlay
to add url to button.
(gnus-article-link-map): New variable.
(gnus-article-open-link-with-browse-url)
(gnus-article-open-link-with-emacs-w3m): New functions.
(gnus-article-link-menu): New menu.
(gnus-article-add-button): Add url string as text property to button.
(gnus-button-push): Assume gnus-button-url is text property.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Type: text/x-patch, Size: 4480 bytes --]
--- gnus-art.el~ 2010-04-18 23:04:00 +0000
+++ gnus-art.el 2010-04-21 06:07:17 +0000
@@ -7781,15 +7781,17 @@
(push from gnus-button-marker-list)
(unless (and (eq (car entry) 'gnus-button-url-regexp)
(gnus-article-extend-url-button from start end))
- (gnus-article-add-button start end
- 'gnus-button-push from)))))))))
+ (gnus-article-add-button
+ start end 'gnus-button-push from
+ (and (eq (car entry) 'gnus-button-url-regexp)
+ (buffer-substring start end)))))))))))
(defun gnus-article-extend-url-button (beg start end)
"Extend url button if url is folded into two or more lines.
Return non-nil if button is extended. BEG is a marker that points to
the beginning position of a text containing url. START and END are
the endpoints of a url button before it is extended. The concatenated
-url is put as the `gnus-button-url' overlay property on the button."
+url is put as the `gnus-button-url' text property on the button."
(let ((opoint (point))
(points (list start end))
url delim regexp)
@@ -7829,14 +7831,13 @@
(match-beginning 1))
points)))))
(match-beginning 2)))
+ (setq url (mapconcat 'identity (nreverse url) ""))
(let (gnus-article-mouse-face widget-mouse-face)
(while points
(gnus-article-add-button (pop points) (pop points)
- 'gnus-button-push beg)))
+ 'gnus-button-push beg url)))
(let ((overlay (gnus-make-overlay start end)))
(gnus-overlay-put overlay 'evaporate t)
- (gnus-overlay-put overlay 'gnus-button-url
- (list (mapconcat 'identity (nreverse url) "")))
(when gnus-article-mouse-face
(gnus-overlay-put overlay 'mouse-face gnus-article-mouse-face)))
t)
@@ -7874,8 +7875,45 @@
;;; External functions:
-(defun gnus-article-add-button (from to fun &optional data)
- "Create a button between FROM and TO with callback FUN and data DATA."
+(defvar gnus-article-link-map nil)
+
+(unless gnus-article-link-map
+ (let ((map (make-sparse-keymap)))
+ (setq gnus-article-link-map map)
+ (cond ((featurep 'xemacs)
+ (define-key map [(button3)] 'gnus-article-link-menu))
+ ;; Don't use [mouse-3], which gets submenus not working in GTK Emacs.
+ ((featurep 'gtk)
+ (define-key map [down-mouse-3] 'gnus-article-link-menu)
+ (define-key map [drag-mouse-3] 'undefined)
+ (define-key map [mouse-3] 'undefined))
+ (t
+ (define-key map [mouse-3] 'gnus-article-link-menu)))))
+
+(defun gnus-article-open-link-with-browse-url ()
+ (interactive)
+ (browse-url (get-text-property (point) 'gnus-button-url)))
+
+(defun gnus-article-open-link-with-emacs-w3m ()
+ (interactive)
+ (w3m (get-text-property (point) 'gnus-button-url) t t))
+
+(easy-menu-define gnus-article-link-menu gnus-article-link-map
+ "Link menu."
+ '("Open this link with"
+ ["browse-url" gnus-article-open-link-with-browse-url]
+ ["emacs-w3m" gnus-article-open-link-with-emacs-w3m]))
+
+(defun gnus-article-link-menu (event)
+ "Pop up a link menu."
+ (interactive "e")
+ (mouse-set-point event)
+ (popup-menu gnus-article-link-menu))
+
+(defun gnus-article-add-button (from to fun &optional data url)
+ "Create a button between FROM and TO with callback FUN and data DATA.
+The optional URL is a string that will be put as the `gnus-button-url'
+text property on the button."
(when gnus-article-button-face
(gnus-overlay-put (gnus-make-overlay from to nil t)
'face gnus-article-button-face))
@@ -7884,7 +7922,9 @@
(nconc (and gnus-article-mouse-face
(list gnus-mouse-face-prop gnus-article-mouse-face))
(list 'gnus-callback fun)
- (and data (list 'gnus-data data))))
+ (and data (list 'gnus-data data))
+ (and url (list 'gnus-button-url url
+ 'keymap gnus-article-link-map))))
(widget-convert-button 'link from to :action 'gnus-widget-press-button
:button-keymap gnus-widget-button-keymap))
@@ -7931,13 +7971,14 @@
(inhibit-point-motion-hooks t)
(fun (nth 3 entry))
(args (or (and (eq (car entry) 'gnus-button-url-regexp)
- (get-char-property marker 'gnus-button-url))
+ (get-text-property marker 'gnus-button-url))
(mapcar (lambda (group)
(let ((string (match-string group)))
(set-text-properties
0 (length string) nil string)
string))
(nthcdr 4 entry)))))
+ (unless (consp args) (setq args (list args)))
(cond
((fboundp fun)
(apply fun args))
next prev parent reply other threads:[~2010-04-21 6:08 UTC|newest]
Thread overview: 14+ messages / expand[flat|nested] mbox.gz Atom feed top
2010-04-17 22:41 [emacs-w3m:11211] " jidanni
2010-04-20 17:20 ` Ted Zlatanov
2010-04-21 6:08 ` Katsumi Yamaoka [this message]
2010-04-21 14:23 ` Ted Zlatanov
2010-04-22 1:48 ` [emacs-w3m:11216] " Katsumi Yamaoka
2010-04-23 0:01 ` Ted Zlatanov
2010-06-25 13:24 ` Štěpán Němec
2010-06-27 23:25 ` [emacs-w3m:11246] " Katsumi Yamaoka
2010-06-28 7:58 ` Štěpán Němec
2010-06-29 1:36 ` [emacs-w3m:11248] " Katsumi Yamaoka
2010-06-29 8:57 ` [emacs-w3m:11249] " Štěpán Němec
2010-06-30 0:28 ` [emacs-w3m:11250] " jidanni
2010-07-28 8:33 ` [emacs-w3m:11248] " Štěpán Němec
2010-08-05 14:47 ` Ted Zlatanov
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=b4mwrw149t1.fsf@jpl.org \
--to=yamaoka@jpl.org \
--cc=ding@gnus.org \
--cc=emacs-w3m@namazu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
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 NNTP newsgroup(s).