bug#5975: 24.0.50; [PATCH]Feature request: bookmarking from gnus article buffer

[Thierry Volpiatto <thierry.volpiatto@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 11995 bytes --]

Hi,
actually we can bookmark a gnus mail/news only from summary buffer.
It is useful to be able to bookmark from article buffer and retrieve
position.
Find here a patch attached that fix that.
It is tested i already use it here.


In GNU Emacs 24.0.50.1 (i686-pc-linux-gnu, GTK+ Version 2.18.9)
 of 2010-04-17 on tux
Windowing system distributor `The X.Org Foundation', version 11.0.10706000
configured using `configure  '--prefix=/usr' '--build=i686-pc-linux-gnu' '--host=i686-pc-linux-gnu' '--mandir=/usr/share/man' '--infodir=/usr/share/info' '--datadir=/usr/share' '--sysconfdir=/etc' '--localstatedir=/var/lib' '--program-suffix=-emacs-24' '--infodir=/usr/share/info/emacs-24' '--with-sound' '--with-x' '--without-gconf' '--without-toolkit-scroll-bars' '--with-gif' '--with-jpeg' '--with-png' '--with-rsvg' '--with-tiff' '--with-xpm' '--with-xft' '--without-libotf' '--without-m17n-flt' '--with-x-toolkit=gtk' '--without-hesiod' '--without-kerberos' '--without-kerberos5' '--with-gpm' '--with-dbus' 'build_alias=i686-pc-linux-gnu' 'host_alias=i686-pc-linux-gnu' 'CFLAGS=-march=i686 -pipe -O2' 'LDFLAGS=-Wl,-O1''

Important settings:
  value of $LC_ALL: C
  value of $LC_COLLATE: C
  value of $LC_CTYPE: fr_FR.UTF-8
  value of $LC_MESSAGES: nil
  value of $LC_MONETARY: nil
  value of $LC_NUMERIC: nil
  value of $LC_TIME: nil
  value of $LANG: fr_FR.UTF-8
  value of $XMODIFIERS: nil
  locale-coding-system: utf-8-unix
  default enable-multibyte-characters: t

Major mode: Emacs-Lisp

Minor modes in effect:
  global-undo-tree-mode: t
  undo-tree-mode: t
  eldoc-mode: t
  delete-selection-mode: t
  minibuffer-depth-indicate-mode: t
  auto-image-file-mode: t
  shell-dirtrack-mode: t
  show-paren-mode: t
  display-battery-mode: t
  display-time-mode: t
  diff-auto-refine-mode: t
  savehist-mode: t
  desktop-save-mode: t
  tooltip-mode: t
  mouse-wheel-mode: t
  file-name-shadow-mode: t
  global-font-lock-mode: t
  font-lock-mode: t
  auto-encryption-mode: t
  auto-compression-mode: t
  line-number-mode: t
  transient-mark-mode: t

Recent input:
<up> <up> <up> <up> <up> <up> <up> <up> <up> <up> <up> 
<up> <up> <up> C-z p <up> <up> <up> <up> <up> <up> 
<up> <up> <up> <up> <up> <up> <up> <up> <up> <up> <up> 
<up> <up> <up> <up> <up> <up> <up> <up> <up> <up> <down> 
<down> <down> <down> <down> <left> <left> <left> C-z 
n <down> <down> <down> <down> <down> <down> <down> 
<down> <down> <down> <down> <down> <down> <down> <down> 
<down> <down> <down> <down> <down> <down> <down> <down> 
<down> <down> <down> <down> <down> <down> <down> <down> 
<down> <up> <up> <up> <up> <up> <up> <up> <up> <up> 
<up> <up> <up> <up> <up> <up> <up> <up> <up> <up> <up> 
<up> <up> <up> <up> <up> <up> <up> <up> <up> <up> <up> 
<up> <up> <up> <up> <up> <f5> a q <tab> <down> <down> 
<down> <down> <return> <down> <right> <right> <right> 
<right> <right> <right> <right> <right> <right> <right> 
<right> <right> <right> <right> <right> <right> <right> 
<right> <right> <right> <right> <right> <right> <right> 
<right> <right> <right> <right> <right> <right> <right> 
<right> <right> <right> <right> <right> <right> <right> 
<right> <right> <right> <right> <right> <right> <backspace> 
<backspace> <backspace> <backspace> <backspace> <backspace> 
<backspace> <backspace> <backspace> <backspace> <backspace> 
<backspace> <backspace> p a t c h - 1 0 7 9 6 3 <left> 
<left> <left> <left> <left> <left> r <right> <right> 
<right> <right> <right> <right> . p a t c h <return> 
C-z 5 <up> <up> <up> C-z n <down> <down> <down> <down> 
<down> <down> <down> <down> <down> <down> <down> <down> 
<down> <down> <down> <down> <down> <down> <down> <down> 
<down> <down> <down> <down> <down> <down> <down> <down> 
<down> <down> <down> <down> <down> <up> <up> <up> <up> 
<up> <up> <up> <up> <up> <up> <up> <up> <up> <up> <up> 
<up> <up> <up> <up> <up> <up> <up> <up> <up> <up> <up> 
<up> <up> <up> <up> <up> <up> M-x r e p o r t <ret
urn>

Recent messages:
 [2 times]
Mark set
Quit [2 times]
 [2 times]
qpush -> applying Initial-patch
now at: Initial-patch
Revert buffer from file /home/thierry/labo/emacs-hg-qp/lisp/gnus/gnus-sum.el? (y or n) 

Exported revision 107963 to /home/thierry/labo/emacs-hg-qp/patch-r107963.patch.


Load-path shadows:
/home/thierry/elisp/lua-mode/lua-mode hides /usr/share/emacs/site-lisp/lua-mode/lua-mode
~/elisp/g-client/json hides /usr/share/emacs/24.0.50/lisp/json
/usr/share/emacs/site-lisp/flim/hex-util hides /usr/share/emacs/24.0.50/lisp/hex-util
/usr/share/emacs/site-lisp/flim/sha1 hides /usr/share/emacs/24.0.50/lisp/sha1
/usr/share/emacs/site-lisp/flim/md4 hides /usr/share/emacs/24.0.50/lisp/md4
/usr/share/emacs/site-lisp/flim/ntlm hides /usr/share/emacs/24.0.50/lisp/net/ntlm
/usr/share/emacs/site-lisp/flim/hmac-def hides /usr/share/emacs/24.0.50/lisp/net/hmac-def
/usr/share/emacs/site-lisp/flim/sasl-digest hides /usr/share/emacs/24.0.50/lisp/net/sasl-digest
/usr/share/emacs/site-lisp/flim/sasl hides /usr/share/emacs/24.0.50/lisp/net/sasl
/usr/share/emacs/site-lisp/flim/hmac-md5 hides /usr/share/emacs/24.0.50/lisp/net/hmac-md5
/usr/share/emacs/site-lisp/flim/sasl-cram hides /usr/share/emacs/24.0.50/lisp/net/sasl-cram
/usr/share/emacs/site-lisp/flim/sasl-ntlm hides /usr/share/emacs/24.0.50/lisp/net/sasl-ntlm
/home/thierry/elisp/emms/lisp/tq hides /usr/share/emacs/24.0.50/lisp/emacs-lisp/tq

Features:
(shadow emacsbug xgit-dvc xgit xgit-annotate dvc-annotate xgit-log
dvc-bookmarks canlock sha1 sha1-el hex-util em-unix em-script em-prompt
em-ls em-hist em-pred em-glob em-dirs em-cmpl em-basic esh-opt em-banner
em-alias esh-var esh-io esh-cmd esh-ext esh-proc esh-groups eshell
esh-module esh-mode help-mode view hl-line flyspell ispell epa-mail
gnus-fun smiley gnus-ml w3m-cookie sb-emacswiki sb-rss url-cache
url-handlers nnrss parse-time nnfolder nndraft nnmh bbdb-gnus bbdb-snarf
nnml starttls mailalias smtpmail qp gnus-agent gnus-srvr gnus-score
score-mode nnvirtual gnus-cache gnus-cite gnus-demon gnus-namazu
gnus-dired nnshimbun shimbun luna eword-encode eword-decode std11 mel
path-util mime-def mcharset mcs-20 mcs-e20 pces pces-e20 pces-20 broken
pcustom poe gnus-bcklg spam spam-stat gnus-uu yenc gnus-alias mail-extr
gnus-msg align conf-mode newcomment vc-rcs xhg-dvc xhg xhg-annotate
xhg-mq xhg-log bzr-core cg-core xdarcs-core xgit-core xhg-core
xmtn-minimal tla smerge-mode dvc-state dvc-config dvc-diff dvc-fileinfo
diff dvc-cmenu dvc-about dvc-version dvc-revlist uniquify align-let
server el-expectations el-mock csv2org iedit eieio zop-to-char wave-list
wave-display wave-client json netrc g g-cus-load elscreen-server
elscreen-dired elscreen-w3m mule-util alist pym static apel-ver product
elscreen undo-tree smallurl mm-url xml-weather rectangle-utils windmove
sdcv woof screenshot auto-document eiv tv-utils eldoc pcvs pcvs-parse
pcvs-info pcvs-defs showtip delsel init-anything-thierry
descbinds-anything anything-ipython ipython executable anything-grep
grep anything-dabbrev-expand dabbrev shell-history anything-complete
anything-show-completion anything-etags anything-match-plugin etags
anything-traverse anything-delicious anything-mercurial anything-config
w3m-bookmark rx anything firefox-protocol bookmark-firefox-handler
bookmark-extensions bookmark install-elisp find-func mb-depth autodoc
ioccur traverselisp thumb-page moz stumpwm-mode cl-info slime-banner
slime-tramp slime-asdf slime-fancy slime-fontifying-fu slime-package-fu
slime-references slime-xref-browser slime-scratch slime-presentations
slime-highlight-edits slime-fuzzy slime-fancy-inspector slime-c-p-c
slime-editing-commands slime-autodoc slime-parse slime-repl slime
apropos hideshow hyperspec thingatpt slime-autoloads bbdb-autoloads
bbdb-gui bbdb-com bbdb boxquote rect image-file tramp-imap tramp-gw
tramp-fish tramp-smb tramp-cache tramp-ftp tramp-cmds tramp shell
tramp-compat trampver newsticker newst-treeview tree-widget
newst-plainview newst-reader newst-ticker newst-backend ledger pcomplete
esh-arg esh-util extview lpr woman man assoc two-column shell-command
em-term term ehelp electric esh-toggle em-xtra dirtrack flymake pdbtrack
pycomplete python-mode info-look ansi-color pymacs no-word regex-tool
whitespace htmlfontify text-translator-load paren battery time dired-tar
compile comint dired-extension image-dired dired-details yaoddmuse
skeleton sgml-mode emms-mpd-config emms-playlist-limit emms-volume
emms-volume-amixer emms-i18n emms-history emms-score emms-stream-info
emms-metaplaylist-mode emms-bookmarks emms-lastfm-client emms-cue
emms-mode-line-icon emms-browser sort emms-playlist-sort
emms-last-played emms-player-xine emms-player-mpd tq emms-playing-time
emms-lyrics emms-url emms-tag-editor emms-mark emms-mode-line emms-cache
emms-info-ogginfo emms-info-mp3info emms-playlist-mode emms-player-vlc
emms-player-mplayer emms-info emms-streams later-do emms-source-playlist
emms-source-file emms-player-simple emms-setup emms emms-compat winner
dvc-init bzr-gnus tla-gnus xgit-gnus xhg-gnus gnus-art mm-uu mml2015
mm-view smime password-cache dig dvc-gnus tla-core pp tla-autoconf
tla-defs dvc-log vc vc-dispatcher dvc-unified dvc-tips dired-x dired-aux
ffap ediff-merg ediff-diff ediff-wind ediff-help ediff-util ediff-mult
ediff-init ediff dvc-autoloads dvc-core dvc-lisp dvc-buffers dvc-ui
dvc-register dvc-utils dvc-emacs ewoc dvc-defs dvc-site psvn log-edit
ring pcvs-util add-log diff-mode lisppaste-extension lisppaste xml-rpc
url-http tls url-auth url-gw xml htmlize-hack htmlize muse-colors
muse-docbook muse-texinfo texnfo-upd texinfo muse-latex muse-html
muse-xml-common muse-wiki cus-edit cus-start cus-load muse-publish
muse-project muse-protocols muse-regexps muse muse-nested-tags muse-mode
muse-autoloads org-config-thierry cal-china lunar solar cal-dst
cal-bahai cal-islam cal-hebrew holidays hol-loaddefs vc-hg org-wl
org-w3m org-vm org-rmail org-mhe org-mew org-irc org-jsinfo org-infojs
org-html org-exp org-exp-blocks org-info org-gnus org-docview org-bibtex
org-bbdb org-agenda appt diary-lib diary-loaddefs cal-menu calendar
cal-loaddefs org-annotation-helper url url-proxy url-privacy url-expand
url-methods url-history url-cookie url-util url-parse url-vars mailcap
remember org-remember org-datetree org byte-opt bytecomp byte-compile
org-footnote org-src org-list org-faces org-compat org-entities org-macs
noutline outline config-w3m w3m browse-url doc-view jka-compr image-mode
timezone w3m-hist w3m-fb w3m-ems w3m-ccl ccl w3m-favicon w3m-image
w3m-proc w3m-util mime-w3m w3m-load savehist epa-file epa derived epg
epg-config auth-source dired gnus-async nntp gnus-sum nnoo gnus-group
time-date gnus-undo nnmail mail-source format-spec gnus-start gnus-spec
gnus-int gnus-range message sendmail regexp-opt rfc822 mml mml-sec
mm-decode mm-bodies mm-encode mail-parse rfc2231 rfc2047 rfc2045
ietf-drums mailabbrev gmm-utils mailheader gnus-win gnus gnus-ems
nnheader gnus-util mail-utils mm-util mail-prsvr wid-edit info easymenu
usage-memo desktop midnight punycode idna mybest-theme edmacro kmacro
eev-thierry iterator eev-all eev-mini-steps eev-browse-url eev-langs
eev-compose eev-glyphs disp-table eev-insert eev-steps eev-bounded eev
easy-mmode advice help-fns advice-preload cl cl-19 site-gentoo w3m-wget
preview-latex tex-site auto-loads tooltip ediff-hook vc-hooks
lisp-float-type mwheel x-win x-dnd font-setting tool-bar dnd fontset
image fringe lisp-mode register page menu-bar rfn-eshadow timer select
scroll-bar mldrag mouse jit-lock font-lock syntax facemenu font-core
frame cham georgian utf-8-lang misc-lang vietnamese tibetan thai
tai-viet lao korean japanese hebrew greek romanian slovak czech european
ethiopic indian cyrillic chinese case-table epa-hook jka-cmpr-hook help
simple abbrev loaddefs button minibuffer faces cus-face files
text-properties overlay md5 base64 format env code-pages mule custom
widget hashtable-print-readable backquote make-network-process dbusbind
font-render-setting gtk x-toolkit x multi-tty emacs)

-- 
Thierry Volpiatto
Gpg key: http://pgp.mit.edu/


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: patch-r107963.patch --]
[-- Type: text/x-patch, Size: 6253 bytes --]

# HG changeset patch
# User Thierry Volpiatto <thierry.volpiatto@gmail.com>
# Date 1271696126 -7200
# Node ID 450b24a81b9dd4f91e50b2f82cb0fcc81503f70f
# Parent  00b16f9f52adab5048a905c78953c49bdfa2e9a2
Allow to bookmark a mail from a Gnus article buffer and retrieve position.

* lisp/bookmark.el (bookmark-make-record-default) Avoid recording *-context-string when not needed.

* lisp/gnus/gnus-art.el set `bookmark-make-record-function' local.

* lisp/gnus/gnus-sum.el (gnus-summary-bookmark-make-record) allow recording from article buffer.
                        (gnus-summary-bookmark-jump) maybe jump to article buffer.

diff --git a/lisp/bookmark.el b/lisp/bookmark.el
--- a/lisp/bookmark.el
+++ b/lisp/bookmark.el
@@ -528,26 +528,30 @@
     (setq bookmark-current-bookmark stripped-name)
     (bookmark-bmenu-surreptitiously-rebuild-list)))
 
-(defun bookmark-make-record-default (&optional point-only)
+(defun bookmark-make-record-default (&optional point-only pos read-only)
   "Return the record describing the location of a new bookmark.
 Must be at the correct position in the buffer in which the bookmark is
 being set.
 If POINT-ONLY is non-nil, then only return the subset of the
-record that pertains to the location within the buffer."
+record that pertains to the location within the buffer.
+If READ-ONLY is non-nil that's mean buffer is read-only and
+there is no need to record front/rear-context-string, position is enough."
   `(,@(unless point-only `((filename . ,(bookmark-buffer-file-name))))
-    (front-context-string
-     . ,(if (>= (- (point-max) (point)) bookmark-search-size)
-            (buffer-substring-no-properties
-             (point)
-             (+ (point) bookmark-search-size))
-          nil))
-    (rear-context-string
-     . ,(if (>= (- (point) (point-min)) bookmark-search-size)
-            (buffer-substring-no-properties
-             (point)
-             (- (point) bookmark-search-size))
-          nil))
-    (position . ,(point))))
+    ,@(unless read-only `((front-context-string
+                           . ,(if (>= (- (point-max) (point))
+                                      bookmark-search-size)
+                                  (buffer-substring-no-properties
+                                   (point)
+                                   (+ (point) bookmark-search-size))
+                                  nil))))
+    ,@(unless read-only `((rear-context-string
+                           . ,(if (>= (- (point) (point-min))
+                                      bookmark-search-size)
+                                  (buffer-substring-no-properties
+                                   (point)
+                                   (- (point) bookmark-search-size))
+                                  nil))))
+    (position . ,(or pos (point)))))
 
 \f
 ;;; File format stuff
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -4446,6 +4446,8 @@
   (make-local-variable 'gnus-article-image-alist)
   (make-local-variable 'gnus-article-charset)
   (make-local-variable 'gnus-article-ignored-charsets)
+  (set (make-local-variable 'bookmark-make-record-function)
+       'gnus-summary-bookmark-make-record)
   ;; Prevent Emacs 22 from displaying non-break space with `nobreak-space'
   ;; face.
   (set (make-local-variable 'nobreak-char-display) nil)
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -12648,18 +12648,24 @@
 
 (defun gnus-summary-bookmark-make-record ()
   "Make a bookmark entry for a Gnus summary buffer."
-  (unless (and (derived-mode-p 'gnus-summary-mode) gnus-article-current)
-    (error "Please retry from the Gnus summary buffer")) ;[1]
-  (let* ((subject (elt (gnus-summary-article-header) 1))
-         (grp     (car gnus-article-current))
-         (art     (cdr gnus-article-current))
-         (head    (gnus-summary-article-header art))
-         (id      (mail-header-id head)))
-    `(,subject
-      ,@(bookmark-make-record-default 'point-only)
-      (location . ,(format "Gnus %s:%d:%s" grp art id))
-      (group . ,grp) (article . ,art)
-      (message-id . ,id) (handler . gnus-summary-bookmark-jump))))
+  (let (pos buf)
+    (unless (and (derived-mode-p 'gnus-summary-mode) gnus-article-current)
+      (save-restriction ; FIXME is it necessary to widen?
+        (widen) (setq pos (point))) ; Set position in gnus-article buffer.
+      (setq buf "art") ; We are recording bookmark from article buffer.
+      (gnus-article-show-summary)) ; Go back in summary buffer.
+    ;; We are now recording bookmark from summary buffer.
+    (unless buf (setq buf "sum"))
+    (let* ((subject (elt (gnus-summary-article-header) 1))
+           (grp     (car gnus-article-current))
+           (art     (cdr gnus-article-current))
+           (head    (gnus-summary-article-header art))
+           (id      (mail-header-id head)))
+      `(,subject
+        ,@(bookmark-make-record-default 'point-only pos 'read-only)
+        (location . ,(format "Gnus-%s %s:%d:%s" buf grp art id))
+        (group . ,grp) (article . ,art)
+        (message-id . ,id) (handler . gnus-summary-bookmark-jump)))))
 
 ;;;###autoload
 (defun gnus-summary-bookmark-jump (bookmark)
@@ -12667,10 +12673,18 @@
 BOOKMARK is a bookmark name or a bookmark record."
   (let ((group    (bookmark-prop-get bookmark 'group))
         (article  (bookmark-prop-get bookmark 'article))
-        (id       (bookmark-prop-get bookmark 'message-id)))
+        (id       (bookmark-prop-get bookmark 'message-id))
+        (buf      (car (split-string (bookmark-prop-get bookmark 'location)))))
     (gnus-fetch-group group (list article))
     (gnus-summary-insert-cached-articles)
     (gnus-summary-goto-article id nil 'force)
+    ;; FIXME we have to wait article buffer is ready (only large buffer)
+    ;; Is there a better solution to know that?
+    ;; If we don't wait `bookmark-default-handler' will have no chance
+    ;; to set position. However there is no error, just wrong pos.
+    (sit-for 1)
+    (when (string= buf "Gnus-art")
+      (other-window 1))
     (bookmark-default-handler
      `(""
        (buffer . ,(current-buffer))