/[emacs]/emacs/lisp/gnus/gnus-art.el
ViewVC logotype

Diff of /emacs/lisp/gnus/gnus-art.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.49.2.1 by schwab, Thu Jul 22 16:45:46 2004 UTC revision 1.49.2.2 by rsteib, Sun Aug 22 19:35:29 2004 UTC
# Line 1  Line 1 
1  ;;; gnus-art.el --- article mode commands for Gnus  ;;; gnus-art.el --- article mode commands for Gnus
2  ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003  ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
3  ;;        Free Software Foundation, Inc.  ;;        Free Software Foundation, Inc.
4    
5  ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>  ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
# Line 1457  Initialized from `text-mode-syntax-table Line 1457  Initialized from `text-mode-syntax-table
1457    `(save-excursion    `(save-excursion
1458       (set-buffer gnus-article-buffer)       (set-buffer gnus-article-buffer)
1459       (save-restriction       (save-restriction
1460         (let ((buffer-read-only nil)         (let ((inhibit-read-only t)
1461               (inhibit-point-motion-hooks t)               (inhibit-point-motion-hooks t)
1462               (case-fold-search t))               (case-fold-search t))
1463           (article-narrow-to-head)           (article-narrow-to-head)
# Line 1469  Initialized from `text-mode-syntax-table Line 1469  Initialized from `text-mode-syntax-table
1469  (defmacro gnus-with-article-buffer (&rest forms)  (defmacro gnus-with-article-buffer (&rest forms)
1470    `(save-excursion    `(save-excursion
1471       (set-buffer gnus-article-buffer)       (set-buffer gnus-article-buffer)
1472       (let ((buffer-read-only nil))       (let ((inhibit-read-only t))
1473         ,@forms)))         ,@forms)))
1474    
1475  (put 'gnus-with-article-buffer 'lisp-indent-function 0)  (put 'gnus-with-article-buffer 'lisp-indent-function 0)
# Line 1557  Initialized from `text-mode-syntax-table Line 1557  Initialized from `text-mode-syntax-table
1557    (unless gnus-inhibit-hiding    (unless gnus-inhibit-hiding
1558      (save-excursion      (save-excursion
1559        (save-restriction        (save-restriction
1560          (let ((buffer-read-only nil)          (let ((inhibit-read-only t)
1561                (case-fold-search t)                (case-fold-search t)
1562                (max (1+ (length gnus-sorted-header-list)))                (max (1+ (length gnus-sorted-header-list)))
1563                (ignored (when (not gnus-visible-headers)                (ignored (when (not gnus-visible-headers)
# Line 1615  always hide." Line 1615  always hide."
1615               (not gnus-show-all-headers))               (not gnus-show-all-headers))
1616      (save-excursion      (save-excursion
1617        (save-restriction        (save-restriction
1618          (let ((buffer-read-only nil)          (let ((inhibit-read-only t)
1619                (list gnus-boring-article-headers)                (list gnus-boring-article-headers)
1620                (inhibit-point-motion-hooks t)                (inhibit-point-motion-hooks t)
1621                elem)                elem)
# Line 1769  always hide." Line 1769  always hide."
1769  (defun article-normalize-headers ()  (defun article-normalize-headers ()
1770    "Make all header lines 40 characters long."    "Make all header lines 40 characters long."
1771    (interactive)    (interactive)
1772    (let ((buffer-read-only nil)    (let ((inhibit-read-only t)
1773          column)          column)
1774      (save-excursion      (save-excursion
1775        (save-restriction        (save-restriction
# Line 1813  FROM is a string of characters to transl Line 1813  FROM is a string of characters to transl
1813  characters to translate to."  characters to translate to."
1814    (save-excursion    (save-excursion
1815      (when (article-goto-body)      (when (article-goto-body)
1816        (let ((buffer-read-only nil)        (let ((inhibit-read-only t)
1817              (x (make-string 225 ?x))              (x (make-string 225 ?x))
1818              (i -1))              (i -1))
1819          (while (< (incf i) (length x))          (while (< (incf i) (length x))
# Line 1829  characters to translate to." Line 1829  characters to translate to."
1829  MAP is an alist where the elements are on the form (\"from\" \"to\")."  MAP is an alist where the elements are on the form (\"from\" \"to\")."
1830    (save-excursion    (save-excursion
1831      (when (article-goto-body)      (when (article-goto-body)
1832        (let ((buffer-read-only nil)        (let ((inhibit-read-only t)
1833              elem)              elem)
1834          (while (setq elem (pop map))          (while (setq elem (pop map))
1835            (save-excursion            (save-excursion
# Line 1841  MAP is an alist where the elements are o Line 1841  MAP is an alist where the elements are o
1841    (interactive)    (interactive)
1842    (save-excursion    (save-excursion
1843      (when (article-goto-body)      (when (article-goto-body)
1844        (let ((buffer-read-only nil))        (let ((inhibit-read-only t))
1845          (while (search-forward "\b" nil t)          (while (search-forward "\b" nil t)
1846            (let ((next (char-after))            (let ((next (char-after))
1847                  (previous (char-after (- (point) 2))))                  (previous (char-after (- (point) 2))))
# Line 1949  unfolded." Line 1949  unfolded."
1949    "Fill lines that are wider than the window width."    "Fill lines that are wider than the window width."
1950    (interactive)    (interactive)
1951    (save-excursion    (save-excursion
1952      (let ((buffer-read-only nil)      (let ((inhibit-read-only t)
1953            (width (window-width (get-buffer-window (current-buffer)))))            (width (window-width (get-buffer-window (current-buffer)))))
1954        (save-restriction        (save-restriction
1955          (article-goto-body)          (article-goto-body)
# Line 1969  unfolded." Line 1969  unfolded."
1969    "Capitalize the first word in each sentence."    "Capitalize the first word in each sentence."
1970    (interactive)    (interactive)
1971    (save-excursion    (save-excursion
1972      (let ((buffer-read-only nil)      (let ((inhibit-read-only t)
1973            (paragraph-start "^[\n\^L]"))            (paragraph-start "^[\n\^L]"))
1974        (article-goto-body)        (article-goto-body)
1975        (while (not (eobp))        (while (not (eobp))
# Line 1980  unfolded." Line 1980  unfolded."
1980    "Remove trailing CRs and then translate remaining CRs into LFs."    "Remove trailing CRs and then translate remaining CRs into LFs."
1981    (interactive)    (interactive)
1982    (save-excursion    (save-excursion
1983      (let ((buffer-read-only nil))      (let ((inhibit-read-only t))
1984        (goto-char (point-min))        (goto-char (point-min))
1985        (while (re-search-forward "\r+$" nil t)        (while (re-search-forward "\r+$" nil t)
1986          (replace-match "" t t))          (replace-match "" t t))
# Line 1992  unfolded." Line 1992  unfolded."
1992    "Remove all trailing blank lines from the article."    "Remove all trailing blank lines from the article."
1993    (interactive)    (interactive)
1994    (save-excursion    (save-excursion
1995      (let ((buffer-read-only nil))      (let ((inhibit-read-only t))
1996        (goto-char (point-max))        (goto-char (point-max))
1997        (delete-region        (delete-region
1998         (point)         (point)
# Line 2113  unfolded." Line 2113  unfolded."
2113    (save-excursion    (save-excursion
2114      (set-buffer gnus-article-buffer)      (set-buffer gnus-article-buffer)
2115      (let ((inhibit-point-motion-hooks t)      (let ((inhibit-point-motion-hooks t)
2116            buffer-read-only            (inhibit-read-only t)
2117            (mail-parse-charset gnus-newsgroup-charset)            (mail-parse-charset gnus-newsgroup-charset)
2118            (mail-parse-ignored-charsets            (mail-parse-ignored-charsets
2119             (save-excursion (set-buffer gnus-summary-buffer)             (save-excursion (set-buffer gnus-summary-buffer)
# Line 2125  unfolded." Line 2125  unfolded."
2125  If PROMPT (the prefix), prompt for a coding system to use."  If PROMPT (the prefix), prompt for a coding system to use."
2126    (interactive "P")    (interactive "P")
2127    (let ((inhibit-point-motion-hooks t) (case-fold-search t)    (let ((inhibit-point-motion-hooks t) (case-fold-search t)
2128          buffer-read-only          (inhibit-read-only t)
2129          (mail-parse-charset gnus-newsgroup-charset)          (mail-parse-charset gnus-newsgroup-charset)
2130          (mail-parse-ignored-charsets          (mail-parse-ignored-charsets
2131           (save-excursion (condition-case nil           (save-excursion (condition-case nil
# Line 2175  If PROMPT (the prefix), prompt for a cod Line 2175  If PROMPT (the prefix), prompt for a cod
2175                               (set-buffer gnus-summary-buffer)                               (set-buffer gnus-summary-buffer)
2176                             (error))                             (error))
2177                           gnus-newsgroup-ignored-charsets))                           gnus-newsgroup-ignored-charsets))
2178          buffer-read-only)          (inhibit-read-only t))
2179      (save-restriction      (save-restriction
2180        (article-narrow-to-head)        (article-narrow-to-head)
2181        (funcall gnus-decode-header-function (point-min) (point-max)))))        (funcall gnus-decode-header-function (point-min) (point-max)))))
# Line 2183  If PROMPT (the prefix), prompt for a cod Line 2183  If PROMPT (the prefix), prompt for a cod
2183  (defun article-decode-group-name ()  (defun article-decode-group-name ()
2184    "Decode group names in `Newsgroups:'."    "Decode group names in `Newsgroups:'."
2185    (let ((inhibit-point-motion-hooks t)    (let ((inhibit-point-motion-hooks t)
2186          buffer-read-only          (inhibit-read-only t)
2187          (method (gnus-find-method-for-group gnus-newsgroup-name)))          (method (gnus-find-method-for-group gnus-newsgroup-name)))
2188      (when (and (or gnus-group-name-charset-method-alist      (when (and (or gnus-group-name-charset-method-alist
2189                     gnus-group-name-charset-group-alist)                     gnus-group-name-charset-group-alist)
# Line 2227  If PROMPT (the prefix), prompt for a cod Line 2227  If PROMPT (the prefix), prompt for a cod
2227    (when gnus-use-idna    (when gnus-use-idna
2228      (save-restriction      (save-restriction
2229        (let ((inhibit-point-motion-hooks t)        (let ((inhibit-point-motion-hooks t)
2230              buffer-read-only)              (inhibit-read-only t))
2231          (article-narrow-to-head)          (article-narrow-to-head)
2232          (goto-char (point-min))          (goto-char (point-min))
2233          (while (re-search-forward "\\(xn--[-A-Za-z0-9.]*\\)[ \t\n\r,>]" nil t)          (while (re-search-forward "\\(xn--[-A-Za-z0-9.]*\\)[ \t\n\r,>]" nil t)
# Line 2250  or not. Line 2250  or not.
2250  If READ-CHARSET, ask for a coding system."  If READ-CHARSET, ask for a coding system."
2251    (interactive (list 'force current-prefix-arg))    (interactive (list 'force current-prefix-arg))
2252    (save-excursion    (save-excursion
2253      (let ((buffer-read-only nil) type charset)      (let ((inhibit-read-only t) type charset)
2254        (if (gnus-buffer-live-p gnus-original-article-buffer)        (if (gnus-buffer-live-p gnus-original-article-buffer)
2255            (with-current-buffer gnus-original-article-buffer            (with-current-buffer gnus-original-article-buffer
2256              (setq type              (setq type
# Line 2280  If FORCE, decode the article whether it Line 2280  If FORCE, decode the article whether it
2280  If READ-CHARSET, ask for a coding system."  If READ-CHARSET, ask for a coding system."
2281    (interactive (list 'force current-prefix-arg))    (interactive (list 'force current-prefix-arg))
2282    (save-excursion    (save-excursion
2283      (let ((buffer-read-only nil) type charset)      (let ((inhibit-read-only t) type charset)
2284        (if (gnus-buffer-live-p gnus-original-article-buffer)        (if (gnus-buffer-live-p gnus-original-article-buffer)
2285            (with-current-buffer gnus-original-article-buffer            (with-current-buffer gnus-original-article-buffer
2286              (setq type              (setq type
# Line 2315  If READ-CHARSET, ask for a coding system Line 2315  If READ-CHARSET, ask for a coding system
2315    (interactive)    (interactive)
2316    (require 'rfc1843)    (require 'rfc1843)
2317    (save-excursion    (save-excursion
2318      (let ((buffer-read-only nil))      (let ((inhibit-read-only t))
2319        (rfc1843-decode-region (point-min) (point-max)))))        (rfc1843-decode-region (point-min) (point-max)))))
2320    
2321  (defun article-unsplit-urls ()  (defun article-unsplit-urls ()
2322    "Remove the newlines that some other mailers insert into URLs."    "Remove the newlines that some other mailers insert into URLs."
2323    (interactive)    (interactive)
2324    (save-excursion    (save-excursion
2325      (let ((buffer-read-only nil))      (let ((inhibit-read-only t))
2326        (goto-char (point-min))        (goto-char (point-min))
2327        (while (re-search-forward        (while (re-search-forward
2328                "^\\(\\(https?\\|ftp\\)://\\S-+\\) *\n\\(\\S-+\\)" nil t)                "^\\(\\(https?\\|ftp\\)://\\S-+\\) *\n\\(\\S-+\\)" nil t)
# Line 2336  If READ-CHARSET, ask for a coding system Line 2336  If READ-CHARSET, ask for a coding system
2336  If READ-CHARSET, ask for a coding system."  If READ-CHARSET, ask for a coding system."
2337    (interactive "P")    (interactive "P")
2338    (save-excursion    (save-excursion
2339      (let ((buffer-read-only nil)      (let ((inhibit-read-only t)
2340            charset)            charset)
2341        (when (gnus-buffer-live-p gnus-original-article-buffer)        (when (gnus-buffer-live-p gnus-original-article-buffer)
2342          (with-current-buffer gnus-original-article-buffer          (with-current-buffer gnus-original-article-buffer
# Line 2401  The `gnus-list-identifiers' variable spe Line 2401  The `gnus-list-identifiers' variable spe
2401          (regexp (if (consp gnus-list-identifiers)          (regexp (if (consp gnus-list-identifiers)
2402                      (mapconcat 'identity gnus-list-identifiers " *\\|")                      (mapconcat 'identity gnus-list-identifiers " *\\|")
2403                    gnus-list-identifiers))                    gnus-list-identifiers))
2404          buffer-read-only)          (inhibit-read-only))
2405      (when regexp      (when regexp
2406        (save-excursion        (save-excursion
2407          (save-restriction          (save-restriction
# Line 2423  always hide." Line 2423  always hide."
2423    (interactive (gnus-article-hidden-arg))    (interactive (gnus-article-hidden-arg))
2424    (unless (gnus-article-check-hidden-text 'pem arg)    (unless (gnus-article-check-hidden-text 'pem arg)
2425      (save-excursion      (save-excursion
2426        (let (buffer-read-only end)        (let ((inhibit-read-only t) end)
2427          (goto-char (point-min))          (goto-char (point-min))
2428          ;; Hide the horrendously ugly "header".          ;; Hide the horrendously ugly "header".
2429          (when (and (search-forward          (when (and (search-forward
# Line 2473  always hide." Line 2473  always hide."
2473      (save-restriction      (save-restriction
2474        (let ((inhibit-point-motion-hooks t)        (let ((inhibit-point-motion-hooks t)
2475              (gnus-signature-limit nil)              (gnus-signature-limit nil)
2476              buffer-read-only)              (inhibit-read-only t))
2477          (article-goto-body)          (article-goto-body)
2478          (cond          (cond
2479           ((eq banner 'signature)           ((eq banner 'signature)
# Line 2496  always hide." Line 2496  always hide."
2496    (save-excursion    (save-excursion
2497      (set-buffer gnus-article-buffer)      (set-buffer gnus-article-buffer)
2498      (when (article-goto-body)      (when (article-goto-body)
2499        (let* ((buffer-read-only nil)        (let* ((inhibit-read-only t)
2500               (start (point))               (start (point))
2501               (end (point-max))               (end (point-max))
2502               (orig (buffer-substring start end))               (orig (buffer-substring start end))
# Line 2514  always hide." Line 2514  always hide."
2514    (unless (gnus-article-check-hidden-text 'signature arg)    (unless (gnus-article-check-hidden-text 'signature arg)
2515      (save-excursion      (save-excursion
2516        (save-restriction        (save-restriction
2517          (let ((buffer-read-only nil))          (let ((inhibit-read-only t))
2518            (when (gnus-article-narrow-to-signature)            (when (gnus-article-narrow-to-signature)
2519              (gnus-article-hide-text-type              (gnus-article-hide-text-type
2520               (point-min) (point-max) 'signature))))))               (point-min) (point-max) 'signature))))))
# Line 2534  always hide." Line 2534  always hide."
2534    (interactive)    (interactive)
2535    (save-excursion    (save-excursion
2536      (let ((inhibit-point-motion-hooks t)      (let ((inhibit-point-motion-hooks t)
2537            buffer-read-only)            (inhibit-read-only t))
2538        (when (article-goto-body)        (when (article-goto-body)
2539          (while (and (not (eobp))          (while (and (not (eobp))
2540                      (looking-at "[ \t]*$"))                      (looking-at "[ \t]*$"))
# Line 2569  Point is left at the beginning of the na Line 2569  Point is left at the beginning of the na
2569    (interactive)    (interactive)
2570    (save-excursion    (save-excursion
2571      (let ((inhibit-point-motion-hooks t)      (let ((inhibit-point-motion-hooks t)
2572            buffer-read-only)            (inhibit-read-only t))
2573        ;; First make all blank lines empty.        ;; First make all blank lines empty.
2574        (article-goto-body)        (article-goto-body)
2575        (while (re-search-forward "^[ \t]+$" nil t)        (while (re-search-forward "^[ \t]+$" nil t)
# Line 2588  Point is left at the beginning of the na Line 2588  Point is left at the beginning of the na
2588    (interactive)    (interactive)
2589    (save-excursion    (save-excursion
2590      (let ((inhibit-point-motion-hooks t)      (let ((inhibit-point-motion-hooks t)
2591            buffer-read-only)            (inhibit-read-only t))
2592        (article-goto-body)        (article-goto-body)
2593        (while (re-search-forward "^[ \t]+" nil t)        (while (re-search-forward "^[ \t]+" nil t)
2594          (replace-match "" t t)))))          (replace-match "" t t)))))
# Line 2598  Point is left at the beginning of the na Line 2598  Point is left at the beginning of the na
2598    (interactive)    (interactive)
2599    (save-excursion    (save-excursion
2600      (let ((inhibit-point-motion-hooks t)      (let ((inhibit-point-motion-hooks t)
2601            buffer-read-only)            (inhibit-read-only t))
2602        (article-goto-body)        (article-goto-body)
2603        (while (re-search-forward "[ \t]+$" nil t)        (while (re-search-forward "[ \t]+$" nil t)
2604          (replace-match "" t t)))))          (replace-match "" t t)))))
# Line 2615  Point is left at the beginning of the na Line 2615  Point is left at the beginning of the na
2615    (interactive)    (interactive)
2616    (save-excursion    (save-excursion
2617      (let ((inhibit-point-motion-hooks t)      (let ((inhibit-point-motion-hooks t)
2618            buffer-read-only)            (inhibit-read-only t))
2619        (article-goto-body)        (article-goto-body)
2620        (while (re-search-forward "^[ \t]*\n" nil t)        (while (re-search-forward "^[ \t]*\n" nil t)
2621          (replace-match "" t t)))))          (replace-match "" t t)))))
# Line 2704  means show, 0 means toggle." Line 2704  means show, 0 means toggle."
2704  (defun gnus-article-show-hidden-text (type &optional dummy)  (defun gnus-article-show-hidden-text (type &optional dummy)
2705    "Show all hidden text of type TYPE.    "Show all hidden text of type TYPE.
2706  Originally it is hide instead of DUMMY."  Originally it is hide instead of DUMMY."
2707    (let ((buffer-read-only nil)    (let ((inhibit-read-only t)
2708          (inhibit-point-motion-hooks t))          (inhibit-point-motion-hooks t))
2709      (gnus-remove-text-properties-when      (gnus-remove-text-properties-when
2710       'article-type type       'article-type type
# Line 2769  should replace the \"Date:\" one, or sho Line 2769  should replace the \"Date:\" one, or sho
2769            (forward-line 1))            (forward-line 1))
2770          (when (and date (not (string= date "")))          (when (and date (not (string= date "")))
2771            (goto-char (point-min))            (goto-char (point-min))
2772            (let ((buffer-read-only nil))            (let ((inhibit-read-only t))
2773              ;; Delete any old Date headers.              ;; Delete any old Date headers.
2774              (while (re-search-forward date-regexp nil t)              (while (re-search-forward date-regexp nil t)
2775                (if pos                (if pos
# Line 2988  This format is defined by the `gnus-arti Line 2988  This format is defined by the `gnus-arti
2988  ;;   "Show all hidden text in the article buffer."  ;;   "Show all hidden text in the article buffer."
2989  ;;   (interactive)  ;;   (interactive)
2990  ;;   (save-excursion  ;;   (save-excursion
2991  ;;     (let ((buffer-read-only nil))  ;;     (let ((inhibit-read-only t))
2992  ;;       (gnus-article-unhide-text (point-min) (point-max)))))  ;;       (gnus-article-unhide-text (point-min) (point-max)))))
2993    
2994  (defun article-remove-leading-whitespace ()  (defun article-remove-leading-whitespace ()
# Line 2996  This format is defined by the `gnus-arti Line 2996  This format is defined by the `gnus-arti
2996    (interactive)    (interactive)
2997    (save-excursion    (save-excursion
2998      (save-restriction      (save-restriction
2999        (let ((buffer-read-only nil))        (let ((inhibit-read-only t))
3000          (article-narrow-to-head)          (article-narrow-to-head)
3001          (goto-char (point-min))          (goto-char (point-min))
3002          (while (re-search-forward "^[^ :]+: \\([ \t]+\\)" nil t)          (while (re-search-forward "^[^ :]+: \\([ \t]+\\)" nil t)
# Line 3013  This format is defined by the `gnus-arti Line 3013  This format is defined by the `gnus-arti
3013                            gnus-article-emphasis-alist)                            gnus-article-emphasis-alist)
3014                        (error))                        (error))
3015                      gnus-emphasis-alist))                      gnus-emphasis-alist))
3016              (buffer-read-only nil)              (inhibit-read-only t)
3017              (props (append '(article-type emphasis)              (props (append '(article-type emphasis)
3018                             gnus-hidden-properties))                             gnus-hidden-properties))
3019              regexp elem beg invisible visible face)              regexp elem beg invisible visible face)
# Line 3413  If variable `gnus-use-long-file-name' is Line 3413  If variable `gnus-use-long-file-name' is
3413                          (mm-handle-multipart-ctl-parameter                          (mm-handle-multipart-ctl-parameter
3414                           mm-security-handle 'gnus-info)))))                           mm-security-handle 'gnus-info)))))
3415            (when info            (when info
3416              (let (buffer-read-only bface eface)              (let ((inhibit-read-only t) bface eface)
3417                (save-restriction                (save-restriction
3418                  (message-narrow-to-head)                  (message-narrow-to-head)
3419                  (goto-char (point-max))                  (goto-char (point-max))
# Line 3718  If ALL-HEADERS is non-nil, no headers ar Line 3718  If ALL-HEADERS is non-nil, no headers ar
3718          (when (and (boundp 'transient-mark-mode)          (when (and (boundp 'transient-mark-mode)
3719                     transient-mark-mode)                     transient-mark-mode)
3720            (setq mark-active nil))            (setq mark-active nil))
3721          (if (not (setq result (let ((buffer-read-only nil))          (if (not (setq result (let ((inhibit-read-only t))
3722                                  (gnus-request-article-this-buffer                                  (gnus-request-article-this-buffer
3723                                   article group))))                                   article group))))
3724              ;; There is no such article.              ;; There is no such article.
# Line 3813  If ALL-HEADERS is non-nil, no headers ar Line 3813  If ALL-HEADERS is non-nil, no headers ar
3813    ;; Hooks for getting information from the article.    ;; Hooks for getting information from the article.
3814    ;; This hook must be called before being narrowed.    ;; This hook must be called before being narrowed.
3815    (let ((gnus-article-buffer (current-buffer))    (let ((gnus-article-buffer (current-buffer))
3816          buffer-read-only)          buffer-read-only
3817            (inhibit-read-only t))
3818      (unless (eq major-mode 'gnus-article-mode)      (unless (eq major-mode 'gnus-article-mode)
3819        (gnus-article-mode))        (gnus-article-mode))
3820      (setq buffer-read-only nil      (setq buffer-read-only nil
# Line 3933  General format specifiers can also be us Line 3934  General format specifiers can also be us
3934          (mm-remove-parts handles)          (mm-remove-parts handles)
3935          (goto-char (point-min))          (goto-char (point-min))
3936          (or (search-forward "\n\n") (goto-char (point-max)))          (or (search-forward "\n\n") (goto-char (point-max)))
3937          (let (buffer-read-only)          (let ((inhibit-read-only t))
3938            (delete-region (point) (point-max))            (delete-region (point) (point-max))
3939            (mm-display-parts handles))))))            (mm-display-parts handles))))))
3940    
# Line 4231  are decompressed." Line 4232  are decompressed."
4232    (let* ((handle (or handle (get-text-property (point) 'gnus-data)))    (let* ((handle (or handle (get-text-property (point) 'gnus-data)))
4233           contents charset           contents charset
4234           (b (point))           (b (point))
4235           buffer-read-only)           (inhibit-read-only t))
4236      (when handle      (when handle
4237        (if (and (not arg) (mm-handle-undisplayer handle))        (if (and (not arg) (mm-handle-undisplayer handle))
4238            (mm-remove-part handle)            (mm-remove-part handle)
# Line 4266  specified charset." Line 4267  specified charset."
4267    (let* ((handle (or handle (get-text-property (point) 'gnus-data)))    (let* ((handle (or handle (get-text-property (point) 'gnus-data)))
4268           contents charset           contents charset
4269           (b (point))           (b (point))
4270           buffer-read-only)           (inhibit-read-only t))
4271      (when handle      (when handle
4272        (if (mm-handle-undisplayer handle)        (if (mm-handle-undisplayer handle)
4273            (mm-remove-part handle))            (mm-remove-part handle))
# Line 4305  If no internal viewer is available, use Line 4306  If no internal viewer is available, use
4306           (mail-parse-ignored-charsets           (mail-parse-ignored-charsets
4307            (save-excursion (set-buffer gnus-summary-buffer)            (save-excursion (set-buffer gnus-summary-buffer)
4308                            gnus-newsgroup-ignored-charsets))                            gnus-newsgroup-ignored-charsets))
4309           buffer-read-only)           (inhibit-read-only t))
4310      (when handle      (when handle
4311        (if (mm-handle-undisplayer handle)        (if (mm-handle-undisplayer handle)
4312            (mm-remove-part handle)            (mm-remove-part handle)
# Line 4410  N is the numerical prefix." Line 4411  N is the numerical prefix."
4411    "Display HANDLE and fix MIME button."    "Display HANDLE and fix MIME button."
4412    (let ((id (get-text-property (point) 'gnus-part))    (let ((id (get-text-property (point) 'gnus-part))
4413          (point (point))          (point (point))
4414          buffer-read-only)          (inhibit-read-only t))
4415      (forward-line 1)      (forward-line 1)
4416      (prog1      (prog1
4417          (let ((window (selected-window))          (let ((window (selected-window))
# Line 4541  N is the numerical prefix." Line 4542  N is the numerical prefix."
4542                            (mm-dissect-buffer nil gnus-article-loose-mime)                            (mm-dissect-buffer nil gnus-article-loose-mime)
4543                            (and gnus-article-emulate-mime                            (and gnus-article-emulate-mime
4544                                 (mm-uu-dissect))))                                 (mm-uu-dissect))))
4545               buffer-read-only handle name type b e display)               (inhibit-read-only t) handle name type b e display)
4546          (when (and (not ihandles)          (when (and (not ihandles)
4547                     (not gnus-displaying-mime))                     (not gnus-displaying-mime))
4548            ;; Top-level call; we clean up.            ;; Top-level call; we clean up.
# Line 4736  If displaying \"text/html\" is discourag Line 4737  If displaying \"text/html\" is discourag
4737    (let* ((preferred (or preferred (mm-preferred-alternative handles)))    (let* ((preferred (or preferred (mm-preferred-alternative handles)))
4738           (ihandles handles)           (ihandles handles)
4739           (point (point))           (point (point))
4740           handle buffer-read-only from props begend not-pref)           handle (inhibit-read-only t) from props begend not-pref)
4741      (save-window-excursion      (save-window-excursion
4742        (save-restriction        (save-restriction
4743          (when ibegend          (when ibegend
# Line 4939  If given a numerical ARG, move forward A Line 4940  If given a numerical ARG, move forward A
4940      (widen)      (widen)
4941      ;; Remove any old next/prev buttons.      ;; Remove any old next/prev buttons.
4942      (when (gnus-visual-p 'page-marker)      (when (gnus-visual-p 'page-marker)
4943        (let ((buffer-read-only nil))        (let ((inhibit-read-only t))
4944          (gnus-remove-text-with-property 'gnus-prev)          (gnus-remove-text-with-property 'gnus-prev)
4945          (gnus-remove-text-with-property 'gnus-next)))          (gnus-remove-text-with-property 'gnus-next)))
4946      (if      (if
# Line 4959  If given a numerical ARG, move forward A Line 4960  If given a numerical ARG, move forward A
4960             (match-beginning 0)             (match-beginning 0)
4961           (point)))           (point)))
4962        (when (and (gnus-visual-p 'page-marker)        (when (and (gnus-visual-p 'page-marker)
4963                   (not (= (point-min) 1)))                   (> (point-min) (save-restriction (widen) (point-min))))
4964          (save-excursion          (save-excursion
4965            (goto-char (point-min))            (goto-char (point-min))
4966            (gnus-insert-prev-page-button)))            (gnus-insert-prev-page-button)))
# Line 5411  If given a prefix, show the hidden text Line 5412  If given a prefix, show the hidden text
5412                    (backend (car (gnus-find-method-for-group                    (backend (car (gnus-find-method-for-group
5413                                   gnus-newsgroup-name)))                                   gnus-newsgroup-name)))
5414                    result                    result
5415                    (buffer-read-only nil))                    (inhibit-read-only t))
5416                (if (or (not (listp methods))                (if (or (not (listp methods))
5417                        (and (symbolp (car methods))                        (and (symbolp (car methods))
5418                             (assq (car methods) nnoo-definition-alist)))                             (assq (car methods) nnoo-definition-alist)))
# Line 5463  If given a prefix, show the hidden text Line 5464  If given a prefix, show the hidden text
5464              (buffer-disable-undo)              (buffer-disable-undo)
5465              (setq major-mode 'gnus-original-article-mode)              (setq major-mode 'gnus-original-article-mode)
5466              (setq buffer-read-only t))              (setq buffer-read-only t))
5467            (let (buffer-read-only)            (let ((inhibit-read-only t))
5468              (erase-buffer)              (erase-buffer)
5469              (insert-buffer-substring gnus-article-buffer))              (insert-buffer-substring gnus-article-buffer))
5470            (setq gnus-original-article (cons group article)))            (setq gnus-original-article (cons group article)))
# Line 5562  If given a prefix, show the hidden text Line 5563  If given a prefix, show the hidden text
5563      ["Body" message-goto-body t]      ["Body" message-goto-body t]
5564      ["Signature" message-goto-signature t]))      ["Signature" message-goto-signature t]))
5565    
5566  (define-derived-mode gnus-article-edit-mode text-mode "Article Edit"  (define-derived-mode gnus-article-edit-mode message-mode "Article Edit"
5567    "Major mode for editing articles.    "Major mode for editing articles.
5568  This is an extended text-mode.  This is an extended text-mode.
5569    
# Line 6285  do the highlighting.  See the documentat Line 6286  do the highlighting.  See the documentat
6286      (set-buffer gnus-article-buffer)      (set-buffer gnus-article-buffer)
6287      (save-restriction      (save-restriction
6288        (let ((alist gnus-header-face-alist)        (let ((alist gnus-header-face-alist)
6289              (buffer-read-only nil)              (inhibit-read-only t)
6290              (case-fold-search t)              (case-fold-search t)
6291              (inhibit-point-motion-hooks t)              (inhibit-point-motion-hooks t)
6292              entry regexp header-face field-face from hpoints fpoints)              entry regexp header-face field-face from hpoints fpoints)
# Line 6324  It does this by highlighting everything Line 6325  It does this by highlighting everything
6325    (interactive)    (interactive)
6326    (save-excursion    (save-excursion
6327      (set-buffer gnus-article-buffer)      (set-buffer gnus-article-buffer)
6328      (let ((buffer-read-only nil)      (let ((inhibit-read-only t)
6329            (inhibit-point-motion-hooks t))            (inhibit-point-motion-hooks t))
6330        (save-restriction        (save-restriction
6331          (when (and gnus-signature-face          (when (and gnus-signature-face
# Line 6349  specified by `gnus-button-alist'." Line 6350  specified by `gnus-button-alist'."
6350    (interactive (list 'force))    (interactive (list 'force))
6351    (save-excursion    (save-excursion
6352      (set-buffer gnus-article-buffer)      (set-buffer gnus-article-buffer)
6353      (let ((buffer-read-only nil)      (let ((inhibit-read-only t)
6354            (inhibit-point-motion-hooks t)            (inhibit-point-motion-hooks t)
6355            (case-fold-search t)            (case-fold-search t)
6356            (alist gnus-button-alist)            (alist gnus-button-alist)
# Line 6394  specified by `gnus-button-alist'." Line 6395  specified by `gnus-button-alist'."
6395    (save-excursion    (save-excursion
6396      (set-buffer gnus-article-buffer)      (set-buffer gnus-article-buffer)
6397      (save-restriction      (save-restriction
6398        (let ((buffer-read-only nil)        (let ((inhibit-read-only t)
6399              (inhibit-point-motion-hooks t)              (inhibit-point-motion-hooks t)
6400              (case-fold-search t)              (case-fold-search t)
6401              (alist gnus-header-button-alist)              (alist gnus-header-button-alist)
# Line 6452  specified by `gnus-button-alist'." Line 6453  specified by `gnus-button-alist'."
6453  (defun gnus-signature-toggle (end)  (defun gnus-signature-toggle (end)
6454    (save-excursion    (save-excursion
6455      (set-buffer gnus-article-buffer)      (set-buffer gnus-article-buffer)
6456      (let ((buffer-read-only nil)      (let ((inhibit-read-only t)
6457            (inhibit-point-motion-hooks t))            (inhibit-point-motion-hooks t))
6458        (if (text-property-any end (point-max) 'article-type 'signature)        (if (text-property-any end (point-max) 'article-type 'signature)
6459            (progn            (progn
# Line 6679  specified by `gnus-button-alist'." Line 6680  specified by `gnus-button-alist'."
6680    
6681  (defun gnus-insert-prev-page-button ()  (defun gnus-insert-prev-page-button ()
6682    (let ((b (point))    (let ((b (point))
6683          (buffer-read-only nil))          (inhibit-read-only t))
6684      (gnus-eval-format      (gnus-eval-format
6685       gnus-prev-page-line-format nil       gnus-prev-page-line-format nil
6686       `(,@(gnus-local-map-property gnus-prev-page-map)       `(,@(gnus-local-map-property gnus-prev-page-map)
# Line 6730  specified by `gnus-button-alist'." Line 6731  specified by `gnus-button-alist'."
6731    
6732  (defun gnus-insert-next-page-button ()  (defun gnus-insert-next-page-button ()
6733    (let ((b (point))    (let ((b (point))
6734          (buffer-read-only nil))          (inhibit-read-only t))
6735      (gnus-eval-format gnus-next-page-line-format nil      (gnus-eval-format gnus-next-page-line-format nil
6736                        `(,@(gnus-local-map-property gnus-next-page-map)                        `(,@(gnus-local-map-property gnus-next-page-map)
6737                            gnus-next t                            gnus-next t
# Line 6765  specified by `gnus-button-alist'." Line 6766  specified by `gnus-button-alist'."
6766    "List of methods used to decode headers.    "List of methods used to decode headers.
6767    
6768  This variable is a list of FUNCTION or (REGEXP . FUNCTION).  If item  This variable is a list of FUNCTION or (REGEXP . FUNCTION).  If item
6769  is FUNCTION, FUNCTION will be apply to all newsgroups.  If item is a  is FUNCTION, FUNCTION will be applied to all newsgroups.  If item is a
6770  \(REGEXP . FUNCTION), FUNCTION will be only apply to the newsgroups  \(REGEXP . FUNCTION), FUNCTION will be only apply to the newsgroups
6771  whose names match REGEXP.  whose names match REGEXP.
6772    
# Line 6904  For example: Line 6905  For example:
6905            (setq references            (setq references
6906                (or (mail-header-references gnus-current-headers) ""))                (or (mail-header-references gnus-current-headers) ""))
6907            (set-buffer gnus-article-buffer)            (set-buffer gnus-article-buffer)
6908            (let* ((buffer-read-only nil)            (let* ((inhibit-read-only t)
6909                   (headers                   (headers
6910                    (mapcar (lambda (field)                    (mapcar (lambda (field)
6911                              (and (save-restriction                              (and (save-restriction
# Line 6984  For example: Line 6985  For example:
6985  (defun gnus-mime-security-verify-or-decrypt (handle)  (defun gnus-mime-security-verify-or-decrypt (handle)
6986    (mm-remove-parts (cdr handle))    (mm-remove-parts (cdr handle))
6987    (let ((region (mm-handle-multipart-ctl-parameter handle 'gnus-region))    (let ((region (mm-handle-multipart-ctl-parameter handle 'gnus-region))
6988          point buffer-read-only)          point (inhibit-read-only t))
6989      (if region      (if region
6990          (goto-char (car region)))          (goto-char (car region)))
6991      (save-restriction      (save-restriction
# Line 7014  For example: Line 7015  For example:
7015                   (not (get-text-property (point) 'gnus-mime-details)))                   (not (get-text-property (point) 'gnus-mime-details)))
7016                  (gnus-mime-security-button-line-format                  (gnus-mime-security-button-line-format
7017                   (get-text-property (point) 'gnus-line-format))                   (get-text-property (point) 'gnus-line-format))
7018                  buffer-read-only)                  (inhibit-read-only t))
7019              (forward-char -1)              (forward-char -1)
7020              (while (eq (get-text-property (point) 'gnus-line-format)              (while (eq (get-text-property (point) 'gnus-line-format)
7021                         gnus-mime-security-button-line-format)                         gnus-mime-security-button-line-format)

Legend:
Removed from v.1.49.2.1  
changed lines
  Added in v.1.49.2.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26