X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-art.el;h=a0eb43eff61181936cf16a1fe286f90e1ae9c409;hb=c85ff27626350a909ee39474fecac012fec8cd26;hp=280914d0f095187d71bd5a71d3479fba1a49bd8a;hpb=50294aaf8e300e030f40137b21eb290123f2e2da;p=gnus diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 280914d0f..a0eb43eff 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -1,7 +1,6 @@ ;;; gnus-art.el --- article mode commands for Gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. +;; Copyright (C) 1996-2011 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -169,7 +168,7 @@ If `gnus-visible-headers' is non-nil, this variable will be ignored." :group 'gnus-article-hiding) (defcustom gnus-visible-headers - "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^[BGF]?Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Mail-Followup-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-From:\\|^X-Sent:" + "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^[BGF]?Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Mail-Followup-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-From:" "*All headers that do not match this regexp will be hidden. This variable can also be a list of regexp of headers to remain visible. If this variable is non-nil, `gnus-ignored-headers' will be ignored." @@ -1015,14 +1014,52 @@ on parts -- for instance, adding Vcard info to a database." :group 'gnus-article-mime :type '(repeat (cons :format "%v" (string :tag "MIME type") function))) -(defcustom gnus-article-date-lapsed-new-header nil - "Whether the X-Sent and Date headers can coexist. -When using `gnus-treat-date-lapsed', the \"X-Sent:\" header will -either replace the old \"Date:\" header (if this variable is nil), or -be added below it (otherwise)." - :version "21.1" +(defcustom gnus-article-date-headers + (let ((types '(ut local english lapsed combined-lapsed + iso8601 original user-defined)) + default) + (dolist (type types) + (let ((variable (intern (format "gnus-treat-date-%s" type)))) + (when (and (boundp variable) + (symbol-value variable)) + (push type default)))) + (when (and (or (not (boundp (intern "gnus-article-date-lapsed-new-header"))) + (not (symbol-value (intern "gnus-article-date-lapsed-new-header")))) + (memq 'lapsed default)) + (setq default (delq 'lapsed default))) + (or default + '(combined-lapsed))) + "A list of Date header formats to display. +Valid formats are `ut' (universal time), `local' (local time +zone), `english' (readable English), `lapsed' (elapsed time), +`combined-lapsed' (both the original date and the elapsed time), +`original' (the original date header), `iso8601' (ISO8601 +format), and `user-defined' (a user-defined format defined by the +`gnus-article-time-format' variable). + +You have as many date headers as you want in the article buffer. +Some of these headers are updated automatically. See +`gnus-article-update-date-headers' for details." + :version "24.1" :group 'gnus-article-headers - :type 'boolean) + :type '(repeat + (item :tag "Universal time (UT)" :value 'ut) + (item :tag "Local time zone" :value 'local) + (item :tag "Readable English" :value 'english) + (item :tag "Elapsed time" :value 'lapsed) + (item :tag "Original and elapsed time" :value 'combined-lapsed) + (item :tag "Original date header" :value 'original) + (item :tag "ISO8601 format" :value 'iso8601) + (item :tag "User-defined" :value 'user-defined))) + +(defcustom gnus-article-update-date-headers 1 + "How often to update the date header. +If nil, don't update it at all." + :version "24.1" + :group 'gnus-article-headers + :type '(choice + (item :tag "Don't update" :value nil) + integer)) (defcustom gnus-article-mime-match-handle-function 'undisplayed-alternative "Function called with a MIME handle as the argument. @@ -1127,6 +1164,15 @@ predicate. See Info node `(gnus)Customizing Articles'." :type gnus-article-treat-head-custom) (put 'gnus-treat-buttonize-head 'highlight t) +(defcustom gnus-treat-date 'head + "Display dates according to the `gnus-article-date-headers' variable. +Valid values are nil, t, `head', `first', `last', an integer or a +predicate. See Info node `(gnus)Customizing Articles'." + :version "24.1" + :group 'gnus-article-treat + :link '(custom-manual "(gnus)Customizing Articles") + :type gnus-article-treat-head-custom) + (defcustom gnus-treat-emphasize 50000 "Emphasize text. Valid values are nil, t, `head', `first', `last', an integer or a @@ -1258,65 +1304,6 @@ predicate. See Info node `(gnus)Customizing Articles'." :type gnus-article-treat-custom) (put 'gnus-treat-highlight-citation 'highlight t) -(defcustom gnus-treat-date-ut nil - "Display the Date in UT (GMT). -Valid values are nil, t, `head', `first', `last', an integer or a -predicate. See Info node `(gnus)Customizing Articles'." - :group 'gnus-article-treat - :link '(custom-manual "(gnus)Customizing Articles") - :type gnus-article-treat-head-custom) - -(defcustom gnus-treat-date-local nil - "Display the Date in the local timezone. -Valid values are nil, t, `head', `first', `last', an integer or a -predicate. See Info node `(gnus)Customizing Articles'." - :group 'gnus-article-treat - :link '(custom-manual "(gnus)Customizing Articles") - :type gnus-article-treat-head-custom) - -(defcustom gnus-treat-date-english nil - "Display the Date in a format that can be read aloud in English. -Valid values are nil, t, `head', `first', `last', an integer or a -predicate. See Info node `(gnus)Customizing Articles'." - :version "22.1" - :group 'gnus-article-treat - :link '(custom-manual "(gnus)Customizing Articles") - :type gnus-article-treat-head-custom) - -(defcustom gnus-treat-date-lapsed nil - "Display the Date header in a way that says how much time has elapsed. -Valid values are nil, t, `head', `first', `last', an integer or a -predicate. See Info node `(gnus)Customizing Articles'." - :group 'gnus-article-treat - :link '(custom-manual "(gnus)Customizing Articles") - :type gnus-article-treat-head-custom) - -(defcustom gnus-treat-date-original nil - "Display the date in the original timezone. -Valid values are nil, t, `head', `first', `last', an integer or a -predicate. See Info node `(gnus)Customizing Articles'." - :group 'gnus-article-treat - :link '(custom-manual "(gnus)Customizing Articles") - :type gnus-article-treat-head-custom) - -(defcustom gnus-treat-date-iso8601 nil - "Display the date in the ISO8601 format. -Valid values are nil, t, `head', `first', `last', an integer or a -predicate. See Info node `(gnus)Customizing Articles'." - :version "21.1" - :group 'gnus-article-treat - :link '(custom-manual "(gnus)Customizing Articles") - :type gnus-article-treat-head-custom) - -(defcustom gnus-treat-date-user-defined nil - "Display the date in a user-defined format. -The format is defined by the `gnus-article-time-format' variable. -Valid values are nil, t, `head', `first', `last', an integer or a -predicate. See Info node `(gnus)Customizing Articles'." - :group 'gnus-article-treat - :link '(custom-manual "(gnus)Customizing Articles") - :type gnus-article-treat-head-custom) - (defcustom gnus-treat-strip-headers-in-body t "Strip the X-No-Archive header line from the beginning of the body. Valid values are nil, t, `head', `first', `last', an integer or a @@ -1674,13 +1661,6 @@ regexp." (gnus-treat-fill-long-lines gnus-article-fill-cited-long-lines) (gnus-treat-strip-cr gnus-article-remove-cr) (gnus-treat-unsplit-urls gnus-article-unsplit-urls) - (gnus-treat-date-ut gnus-article-date-ut) - (gnus-treat-date-local gnus-article-date-local) - (gnus-treat-date-english gnus-article-date-english) - (gnus-treat-date-original gnus-article-date-original) - (gnus-treat-date-user-defined gnus-article-date-user) - (gnus-treat-date-iso8601 gnus-article-date-iso8601) - (gnus-treat-date-lapsed gnus-article-date-lapsed) (gnus-treat-display-x-face gnus-article-display-x-face) (gnus-treat-display-face gnus-article-display-face) (gnus-treat-hide-headers gnus-article-maybe-hide-headers) @@ -1692,6 +1672,7 @@ regexp." (gnus-treat-mail-picon gnus-treat-mail-picon) (gnus-treat-newsgroups-picon gnus-treat-newsgroups-picon) (gnus-treat-strip-pem gnus-article-hide-pem) + (gnus-treat-date gnus-article-treat-date) (gnus-treat-from-gravatar gnus-treat-from-gravatar) (gnus-treat-mail-gravatar gnus-treat-mail-gravatar) (gnus-treat-highlight-headers gnus-article-highlight-headers) @@ -2275,19 +2256,23 @@ unfolded." "Remove all images from the article buffer." (interactive) (gnus-with-article-buffer - (dolist (elem gnus-article-image-alist) - (gnus-delete-images (car elem))))) + (save-restriction + (widen) + (dolist (elem gnus-article-image-alist) + (gnus-delete-images (car elem)))))) (defun gnus-article-show-images () "Show any images that are in the HTML-rendered article buffer. This only works if the article in question is HTML." (interactive) (gnus-with-article-buffer - (dolist (region (gnus-find-text-property-region (point-min) (point-max) - 'image-displayer)) - (destructuring-bind (start end function) region - (funcall function (get-text-property start 'image-url) - start end))))) + (save-restriction + (widen) + (dolist (region (gnus-find-text-property-region (point-min) (point-max) + 'image-displayer)) + (destructuring-bind (start end function) region + (funcall function (get-text-property start 'image-url) + start end)))))) (defun gnus-article-treat-fold-newsgroups () "Unfold folded message headers. @@ -3420,84 +3405,70 @@ lines forward." (forward-line 1) (setq ended t))))) -(defun article-date-ut (&optional type highlight) - "Convert DATE date to universal time in the current article. -If TYPE is `local', convert to local time; if it is `lapsed', output -how much time has lapsed since DATE. For `lapsed', the value of -`gnus-article-date-lapsed-new-header' says whether the \"X-Sent:\" header -should replace the \"Date:\" one, or should be added below it." +(defun article-treat-date () + (article-date-ut gnus-article-date-headers t)) + +(defun article-date-ut (&optional type highlight date-position) + "Convert DATE date to TYPE in the current article. +The default type is `ut'. See `gnus-article-date-headers' for +possible values." (interactive (list 'ut t)) - (let* ((tdate-regexp "^Date:[ \t]\\|^X-Sent:[ \t]") - (date-regexp (cond ((not gnus-article-date-lapsed-new-header) - tdate-regexp) - ((eq type 'lapsed) - "^X-Sent:[ \t]") - (article-lapsed-timer - "^Date:[ \t]") - (t - tdate-regexp))) - (case-fold-search t) + (let* ((case-fold-search t) (inhibit-read-only t) (inhibit-point-motion-hooks t) + (first t) pos date bface eface) (save-excursion (save-restriction - (widen) (goto-char (point-min)) - (while (or (setq date (get-text-property (setq pos (point)) - 'original-date)) - (when (setq pos (next-single-property-change - (point) 'original-date)) - (setq date (get-text-property pos 'original-date)) - t)) - (narrow-to-region - pos (if (setq pos (text-property-any pos (point-max) - 'original-date nil)) - (progn - (goto-char pos) - (if (or (bolp) (eobp)) - (point) - (1+ (point)))) - (point-max))) - (goto-char (point-min)) - (when (re-search-forward tdate-regexp nil t) - (setq bface (get-text-property (point-at-bol) 'face) - eface (get-text-property (1- (point-at-eol)) 'face))) - (goto-char (point-min)) - (setq pos nil) - ;; Delete any old Date headers. - (while (re-search-forward date-regexp nil t) - (if pos - (delete-region (point-at-bol) (progn - (gnus-article-forward-header) - (point))) - (delete-region (point-at-bol) (progn - (gnus-article-forward-header) - (forward-char -1) - (point))) - (setq pos (point)))) - (when (and (not pos) - (re-search-forward tdate-regexp nil t)) - (forward-line 1)) - (gnus-goto-char pos) - (insert (article-make-date-line date (or type 'ut))) - (unless pos - (insert "\n") - (forward-line -1)) - ;; Do highlighting. - (beginning-of-line) - (when (looking-at "\\([^:]+\\): *\\(.*\\)$") - (put-text-property (match-beginning 1) (1+ (match-end 1)) - 'face bface) - (put-text-property (match-beginning 2) (match-end 2) - 'face eface)) - (put-text-property (point-min) (1- (point-max)) 'original-date date) - (goto-char (point-max)) - (widen)))))) + (when (re-search-forward "^Date:" nil t) + (setq bface (get-text-property (point-at-bol) 'face) + eface (get-text-property (1- (point-at-eol)) 'face))) + (goto-char (point-min)) + ;; Delete any old Date headers. + (if date-position + (progn + (goto-char date-position) + (setq date (get-text-property (point) 'original-date)) + (delete-region (point) + (progn + (gnus-article-forward-header) + (point))) + (article-transform-date date type bface eface)) + (while (re-search-forward "^Date:" nil t) + (setq date (get-text-property (match-beginning 0) 'original-date)) + (delete-region (point-at-bol) (progn + (gnus-article-forward-header) + (point))) + (article-transform-date date type bface eface))))))) + +(defun article-transform-date (date type bface eface) + (dolist (this-type (cond + ((null type) + (list 'ut)) + ((atom type) + (list type)) + (t + type))) + (insert (article-make-date-line date (or this-type 'ut)) "\n") + (forward-line -1) + (beginning-of-line) + (put-text-property (point) (1+ (point)) + 'original-date date) + (put-text-property (point) (1+ (point)) + 'gnus-date-type this-type) + ;; Do highlighting. + (when (looking-at "\\([^:]+\\): *\\(.*\\)$") + (put-text-property (match-beginning 1) (1+ (match-end 1)) + 'face bface) + (put-text-property (match-beginning 2) (match-end 2) + 'face eface)) + (forward-line 1))) (defun article-make-date-line (date type) "Return a DATE line of TYPE." - (unless (memq type '(local ut original user iso8601 lapsed english)) + (unless (memq type '(local ut original user-defined iso8601 lapsed english + combined-lapsed)) (error "Unknown conversion type: %s" type)) (condition-case () (let ((time (date-to-time date))) @@ -3525,7 +3496,7 @@ should replace the \"Date:\" one, or should be added below it." (substring date 0 (match-beginning 0)) date))) ;; Let the user define the format. - ((eq type 'user) + ((eq type 'user-defined) (let ((format (or (condition-case nil (with-current-buffer gnus-summary-buffer gnus-article-time-format) @@ -3543,49 +3514,25 @@ should replace the \"Date:\" one, or should be added below it." (format "%s%02d%02d" (if (> tz 0) "+" "-") (/ (abs tz) 3600) (/ (% (abs tz) 3600) 60))))) - ;; Do an X-Sent lapsed format. + ;; Do a lapsed format. ((eq type 'lapsed) - ;; If the date is seriously mangled, the timezone functions are - ;; liable to bug out, so we ignore all errors. - (let* ((now (current-time)) - (real-time (subtract-time now time)) - (real-sec (and real-time - (+ (* (float (car real-time)) 65536) - (cadr real-time)))) - (sec (and real-time (abs real-sec))) - num prev) - (cond - ((null real-time) - "X-Sent: Unknown") - ((zerop sec) - "X-Sent: Now") - (t - (concat - "X-Sent: " - ;; This is a bit convoluted, but basically we go - ;; through the time units for years, weeks, etc, - ;; and divide things to see whether that results - ;; in positive answers. - (mapconcat - (lambda (unit) - (if (zerop (setq num (ffloor (/ sec (cdr unit))))) - ;; The (remaining) seconds are too few to - ;; be divided into this time unit. - "" - ;; It's big enough, so we output it. - (setq sec (- sec (* num (cdr unit)))) - (prog1 - (concat (if prev ", " "") (int-to-string - (floor num)) - " " (symbol-name (car unit)) - (if (> num 1) "s" "")) - (setq prev t)))) - article-time-units "") - ;; If dates are odd, then it might appear like the - ;; article was sent in the future. - (if (> real-sec 0) - " ago" - " in the future")))))) + (concat "Date: " (article-lapsed-string time))) + ;; A combined date/lapsed format. + ((eq type 'combined-lapsed) + (let ((date-string (article-make-date-line date 'original)) + (segments 3) + lapsed-string) + (while (and + (setq lapsed-string + (concat " (" (article-lapsed-string time segments) ")")) + (> (+ (length date-string) + (length lapsed-string)) + (+ fill-column 6)) + (> segments 0)) + (setq segments (1- segments))) + (if (> segments 0) + (concat date-string lapsed-string) + date-string))) ;; Display the date in proper English ((eq type 'english) (let ((dtime (decode-time time))) @@ -3607,9 +3554,56 @@ should replace the \"Date:\" one, or should be added below it." (format "%02d" (nth 2 dtime)) ":" (format "%02d" (nth 1 dtime))))))) - (error + (foo (format "Date: %s (from Gnus)" date)))) +(defun article-lapsed-string (time &optional max-segments) + ;; If the date is seriously mangled, the timezone functions are + ;; liable to bug out, so we ignore all errors. + (let* ((now (current-time)) + (real-time (subtract-time now time)) + (real-sec (and real-time + (+ (* (float (car real-time)) 65536) + (cadr real-time)))) + (sec (and real-time (abs real-sec))) + (segments 0) + num prev) + (unless max-segments + (setq max-segments (length article-time-units))) + (cond + ((null real-time) + "Unknown") + ((zerop sec) + "Now") + (t + (concat + ;; This is a bit convoluted, but basically we go + ;; through the time units for years, weeks, etc, + ;; and divide things to see whether that results + ;; in positive answers. + (mapconcat + (lambda (unit) + (if (or (zerop (setq num (ffloor (/ sec (cdr unit))))) + (>= segments max-segments)) + ;; The (remaining) seconds are too few to + ;; be divided into this time unit. + "" + ;; It's big enough, so we output it. + (setq sec (- sec (* num (cdr unit)))) + (prog1 + (concat (if prev ", " "") (int-to-string + (floor num)) + " " (symbol-name (car unit)) + (if (> num 1) "s" "")) + (setq prev t + segments (1+ segments))))) + article-time-units "") + ;; If dates are odd, then it might appear like the + ;; article was sent in the future. + (if (> real-sec 0) + " ago" + " in the future")))))) + (defun article-date-local (&optional highlight) "Convert the current article date to the local timezone." (interactive (list t)) @@ -3632,26 +3626,42 @@ function and want to see what the date was before converting." (interactive (list t)) (article-date-ut 'lapsed highlight)) +(defun article-date-combined-lapsed (&optional highlight) + "Convert the current article date to time lapsed since it was sent." + (interactive (list t)) + (article-date-ut 'combined-lapsed highlight)) + (defun article-update-date-lapsed () "Function to be run from a timer to update the lapsed time line." (save-match-data - (let (deactivate-mark) - (save-excursion - (ignore-errors - (walk-windows - (lambda (w) - (set-buffer (window-buffer w)) - (when (eq major-mode 'gnus-article-mode) - (let ((mark (point-marker))) - (goto-char (point-min)) - (when (re-search-forward "^X-Sent:" nil t) - (article-date-lapsed t)) - (goto-char (marker-position mark)) - (move-marker mark nil)))) - nil 'visible)))))) + (let ((buffer (current-buffer))) + (ignore-errors + (walk-windows + (lambda (w) + (set-buffer (window-buffer w)) + (when (eq major-mode 'gnus-article-mode) + (let ((old-line (count-lines (point-min) (point))) + (old-column (current-column))) + (goto-char (point-min)) + (while (re-search-forward "^Date:" nil t) + (let ((type (get-text-property (match-beginning 0) 'gnus-date-type))) + (when (memq type '(lapsed combined-lapsed user-format)) + (save-excursion + (article-date-ut type t (match-beginning 0))) + (forward-line 1)))) + (goto-char (point-min)) + (when (> old-column 0) + (setq old-line (1- old-line))) + (forward-line old-line) + (end-of-line) + (when (> (current-column) old-column) + (beginning-of-line) + (forward-char old-column))))) + nil 'visible)) + (set-buffer buffer)))) (defun gnus-start-date-timer (&optional n) - "Start a timer to update the X-Sent header in the article buffers. + "Start a timer to update the Date headers in the article buffers. The numerical prefix says how frequently (in seconds) the function is to run." (interactive "p") @@ -3662,7 +3672,7 @@ is to run." (run-at-time 1 n 'article-update-date-lapsed))) (defun gnus-stop-date-timer () - "Stop the X-Sent timer." + "Stop the Date timer." (interactive) (when article-lapsed-timer (nnheader-cancel-timer article-lapsed-timer) @@ -4287,12 +4297,14 @@ If variable `gnus-use-long-file-name' is non-nil, it is article-date-english article-date-iso8601 article-date-original + article-treat-date article-date-ut article-decode-mime-words article-decode-charset article-decode-encoded-words article-date-user article-date-lapsed + article-date-combined-lapsed article-emphasize article-treat-dumbquotes article-treat-non-ascii @@ -4489,6 +4501,9 @@ commands: (setq gnus-summary-buffer (gnus-summary-buffer-name gnus-newsgroup-name)) (gnus-summary-set-local-parameters gnus-newsgroup-name) + (when (and gnus-article-update-date-headers + (not article-lapsed-timer)) + (gnus-start-date-timer gnus-article-update-date-headers)) (current-buffer))))) ;; Set article window start at LINE, where LINE is the number of lines @@ -5893,18 +5908,7 @@ If displaying \"text/html\" is discouraged \(see (forward-line -1) (setq beg (point))) (gnus-article-insert-newline) - (mm-insert-inline - handle - (let ((charset (or (mail-content-type-get (mm-handle-type handle) - 'charset) - (and (equal type "text/calendar") 'utf-8)))) - (cond ((not charset) - (mm-string-as-multibyte (mm-get-part handle))) - ((eq charset 'gnus-decoded) - (with-current-buffer (mm-handle-buffer handle) - (buffer-string))) - (t - (mm-decode-string (mm-get-part handle) charset))))) + (mm-display-inline handle) (goto-char (point-max)))) ;; Do highlighting. (save-excursion @@ -6275,7 +6279,7 @@ Argument LINES specifies lines to be scrolled up." (save-excursion (end-of-line) (and (pos-visible-in-window-p) ;Not continuation line. - (>= (1+ (point)) (point-max))))) ;Allow for trailing newline. + (>= (point) (point-max))))) ;; Nothing in this page. (if (or (not gnus-page-broken) (save-excursion @@ -6439,6 +6443,8 @@ not have a face in `gnus-article-boring-faces'." (ding) (unless (member keys nosave-in-article) (set-buffer gnus-article-current-summary)) + (when (get func 'disabled) + (error "Function %s disabled" func)) (call-interactively func) (setq new-sum-point (point))) (when (member keys nosave-but-article) @@ -6467,8 +6473,11 @@ not have a face in `gnus-article-boring-faces'." (select-window win)))) (setq in-buffer (current-buffer)) ;; We disable the pick minor mode commands. - (if (and (setq func (let (gnus-pick-mode) - (key-binding keys t))) + (setq func (let (gnus-pick-mode) + (key-binding keys t))) + (when (get func 'disabled) + (error "Function %s disabled" func)) + (if (and func (functionp func) (condition-case code (progn @@ -7475,17 +7484,17 @@ positives are possible." ;; Info links like `C-h i d m Gnus RET' or `C-h i d m Gnus RET i partial RET' 0 (>= gnus-button-emacs-level 1) gnus-button-handle-info-keystrokes 0) ;; This is custom - ("M-x[ \t\n]\\(customize-[^ ]+\\)[ \t\n]RET[ \t\n]\\([^ ]+\\)[ \t\n]RET" 0 + ("M-x[ \t\n]\\(customize-[^ ]+\\)[ \t\n]RET[ \t\n]\\([^ ]+\\)[ \t\n]RET\\>" 0 (>= gnus-button-emacs-level 1) gnus-button-handle-custom 1 2) ;; Emacs help commands - ("M-x[ \t\n]+apropos[ \t\n]+RET[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET" + ("M-x[ \t\n]+apropos[ \t\n]+RET[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET\\>" ;; regexp doesn't match arguments containing ` '. 0 (>= gnus-button-emacs-level 1) gnus-button-handle-apropos 1) - ("M-x[ \t\n]+apropos-command[ \t\n]+RET[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET" + ("M-x[ \t\n]+apropos-command[ \t\n]+RET[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET\\>" 0 (>= gnus-button-emacs-level 1) gnus-button-handle-apropos-command 1) - ("M-x[ \t\n]+apropos-variable[ \t\n]+RET[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET" + ("M-x[ \t\n]+apropos-variable[ \t\n]+RET[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET\\>" 0 (>= gnus-button-emacs-level 1) gnus-button-handle-apropos-variable 1) - ("M-x[ \t\n]+apropos-documentation[ \t\n]+RET[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET" + ("M-x[ \t\n]+apropos-documentation[ \t\n]+RET[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET\\>" 0 (>= gnus-button-emacs-level 1) gnus-button-handle-apropos-documentation 1) ;; The following entries may lead to many false positives so don't enable ;; them by default (use a high button level). @@ -7500,11 +7509,11 @@ positives are possible." 0 (>= gnus-button-emacs-level 9) gnus-button-handle-symbol 1) ("(setq[ \t\n]+\\([a-z][a-z0-9]+-[-a-z0-9]+\\)[ \t\n]+.+)" 1 (>= gnus-button-emacs-level 7) gnus-button-handle-describe-variable 1) - ("\\bM-x[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET" + ("\\bM-x[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET\\>" 1 (>= gnus-button-emacs-level 7) gnus-button-handle-describe-function 1) - ("\\b\\(C-h\\|?\\)[ \t\n]+f[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET" + ("\\b\\(C-h\\|?\\)[ \t\n]+f[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET\\>" 0 (>= gnus-button-emacs-level 1) gnus-button-handle-describe-function 2) - ("\\b\\(C-h\\|?\\)[ \t\n]+v[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET" + ("\\b\\(C-h\\|?\\)[ \t\n]+v[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET\\>" 0 (>= gnus-button-emacs-level 1) gnus-button-handle-describe-variable 2) ("`\\(\\(C-h\\|?\\)[ \t\n]+k[ \t\n]+\\([^']+\\)\\)'" ;; Unlike the other regexps we really have to require quoting @@ -8029,7 +8038,7 @@ url is put as the `gnus-button-url' overlay property on the button." (if (string-match (concat "\\b\\(C-h\\|?\\)[ \t\n]+i[ \t\n]+d?[ \t\n]?m[ \t\n]+" "\\([^ ]+ ?[^ ]+\\)[ \t\n]+RET" - "\\([ \t\n]+i[ \t\n]+[^ ]+ ?[^ ]+[ \t\n]+RET" + "\\([ \t\n]+i[ \t\n]+[^ ]+ ?[^ ]+[ \t\n]+RET\\>" "\\(?:[ \t\n,]*\\)\\)?") url) (setq node (match-string 2 url) @@ -8039,7 +8048,7 @@ url is put as the `gnus-button-url' overlay property on the button." (Info-directory) (Info-menu node) (when (> (length indx) 0) - (string-match (concat "[ \t\n]+i[ \t\n]+\\([^ ]+ ?[^ ]+\\)[ \t\n]+RET" + (string-match (concat "[ \t\n]+i[ \t\n]+\\([^ ]+ ?[^ ]+\\)[ \t\n]+RET\\>" "\\([ \t\n,]*\\)") indx) (setq comma (match-string 2 indx))