Commit 4e7d0221 authored by Stefan Monnier's avatar Stefan Monnier
Browse files

Use inhibit-read-only instead of buffer-read-only.

(gnus-narrow-to-page): Don't assume point-min == 1.
(gnus-article-edit-mode): Derive from message-mode.
(gnus-button-alist): Add buttons to (info "(emacs)Keymaps").
parent 87e8daba
;;; gnus-art.el --- article mode commands for Gnus ;;; gnus-art.el --- article mode commands for Gnus
;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002 ;; Copyright (C) 1996, 97, 98, 1999, 2000, 01, 02, 2004
;; Free Software Foundation, Inc. ;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
...@@ -1142,7 +1142,7 @@ Initialized from `text-mode-syntax-table.") ...@@ -1142,7 +1142,7 @@ Initialized from `text-mode-syntax-table.")
(unless gnus-inhibit-hiding (unless gnus-inhibit-hiding
(save-excursion (save-excursion
(save-restriction (save-restriction
(let ((buffer-read-only nil) (let ((inhibit-read-only t)
(case-fold-search t) (case-fold-search t)
(max (1+ (length gnus-sorted-header-list))) (max (1+ (length gnus-sorted-header-list)))
(ignored (when (not gnus-visible-headers) (ignored (when (not gnus-visible-headers)
...@@ -1200,7 +1200,7 @@ always hide." ...@@ -1200,7 +1200,7 @@ always hide."
(not gnus-show-all-headers)) (not gnus-show-all-headers))
(save-excursion (save-excursion
(save-restriction (save-restriction
(let ((buffer-read-only nil) (let ((inhibit-read-only t)
(list gnus-boring-article-headers) (list gnus-boring-article-headers)
(inhibit-point-motion-hooks t) (inhibit-point-motion-hooks t)
elem) elem)
...@@ -1303,7 +1303,7 @@ always hide." ...@@ -1303,7 +1303,7 @@ always hide."
(defun article-normalize-headers () (defun article-normalize-headers ()
"Make all header lines 40 characters long." "Make all header lines 40 characters long."
(interactive) (interactive)
(let ((buffer-read-only nil) (let ((inhibit-read-only t)
column) column)
(save-excursion (save-excursion
(save-restriction (save-restriction
...@@ -1346,7 +1346,7 @@ FROM is a string of characters to translate from; to is a string of ...@@ -1346,7 +1346,7 @@ FROM is a string of characters to translate from; to is a string of
characters to translate to." characters to translate to."
(save-excursion (save-excursion
(when (article-goto-body) (when (article-goto-body)
(let ((buffer-read-only nil) (let ((inhibit-read-only t)
(x (make-string 225 ?x)) (x (make-string 225 ?x))
(i -1)) (i -1))
(while (< (incf i) (length x)) (while (< (incf i) (length x))
...@@ -1362,7 +1362,7 @@ characters to translate to." ...@@ -1362,7 +1362,7 @@ characters to translate to."
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\")."
(save-excursion (save-excursion
(when (article-goto-body) (when (article-goto-body)
(let ((buffer-read-only nil) (let ((inhibit-read-only t)
elem) elem)
(while (setq elem (pop map)) (while (setq elem (pop map))
(save-excursion (save-excursion
...@@ -1374,7 +1374,7 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")." ...@@ -1374,7 +1374,7 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")."
(interactive) (interactive)
(save-excursion (save-excursion
(when (article-goto-body) (when (article-goto-body)
(let ((buffer-read-only nil)) (let ((inhibit-read-only t))
(while (search-forward "\b" nil t) (while (search-forward "\b" nil t)
(let ((next (char-after)) (let ((next (char-after))
(previous (char-after (- (point) 2)))) (previous (char-after (- (point) 2))))
...@@ -1399,7 +1399,7 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")." ...@@ -1399,7 +1399,7 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")."
"Fill lines that are wider than the window width." "Fill lines that are wider than the window width."
(interactive) (interactive)
(save-excursion (save-excursion
(let ((buffer-read-only nil) (let ((inhibit-read-only t)
(width (window-width (get-buffer-window (current-buffer))))) (width (window-width (get-buffer-window (current-buffer)))))
(save-restriction (save-restriction
(article-goto-body) (article-goto-body)
...@@ -1417,7 +1417,7 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")." ...@@ -1417,7 +1417,7 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")."
"Capitalize the first word in each sentence." "Capitalize the first word in each sentence."
(interactive) (interactive)
(save-excursion (save-excursion
(let ((buffer-read-only nil) (let ((inhibit-read-only t)
(paragraph-start "^[\n\^L]")) (paragraph-start "^[\n\^L]"))
(article-goto-body) (article-goto-body)
(while (not (eobp)) (while (not (eobp))
...@@ -1428,7 +1428,7 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")." ...@@ -1428,7 +1428,7 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")."
"Remove trailing CRs and then translate remaining CRs into LFs." "Remove trailing CRs and then translate remaining CRs into LFs."
(interactive) (interactive)
(save-excursion (save-excursion
(let ((buffer-read-only nil)) (let ((inhibit-read-only t))
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward "\r+$" nil t) (while (re-search-forward "\r+$" nil t)
(replace-match "" t t)) (replace-match "" t t))
...@@ -1440,7 +1440,7 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")." ...@@ -1440,7 +1440,7 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")."
"Remove all trailing blank lines from the article." "Remove all trailing blank lines from the article."
(interactive) (interactive)
(save-excursion (save-excursion
(let ((buffer-read-only nil)) (let ((inhibit-read-only t))
(goto-char (point-max)) (goto-char (point-max))
(delete-region (delete-region
(point) (point)
...@@ -1583,7 +1583,7 @@ If FORCE, decode the article whether it is marked as quoted-printable ...@@ -1583,7 +1583,7 @@ If FORCE, decode the article whether it is marked as quoted-printable
or not." or not."
(interactive (list 'force)) (interactive (list 'force))
(save-excursion (save-excursion
(let ((buffer-read-only nil) type charset) (let ((inhibit-read-only t) type charset)
(if (gnus-buffer-live-p gnus-original-article-buffer) (if (gnus-buffer-live-p gnus-original-article-buffer)
(with-current-buffer gnus-original-article-buffer (with-current-buffer gnus-original-article-buffer
(setq type (setq type
...@@ -1610,7 +1610,7 @@ or not." ...@@ -1610,7 +1610,7 @@ or not."
If FORCE, decode the article whether it is marked as base64 not." If FORCE, decode the article whether it is marked as base64 not."
(interactive (list 'force)) (interactive (list 'force))
(save-excursion (save-excursion
(let ((buffer-read-only nil) type charset) (let ((inhibit-read-only t) type charset)
(if (gnus-buffer-live-p gnus-original-article-buffer) (if (gnus-buffer-live-p gnus-original-article-buffer)
(with-current-buffer gnus-original-article-buffer (with-current-buffer gnus-original-article-buffer
(setq type (setq type
...@@ -1643,14 +1643,14 @@ If FORCE, decode the article whether it is marked as base64 not." ...@@ -1643,14 +1643,14 @@ If FORCE, decode the article whether it is marked as base64 not."
(interactive) (interactive)
(require 'rfc1843) (require 'rfc1843)
(save-excursion (save-excursion
(let ((buffer-read-only nil)) (let ((inhibit-read-only t))
(rfc1843-decode-region (point-min) (point-max))))) (rfc1843-decode-region (point-min) (point-max)))))
(defun article-wash-html () (defun article-wash-html ()
"Format an html article." "Format an html article."
(interactive) (interactive)
(save-excursion (save-excursion
(let ((buffer-read-only nil) (let ((inhibit-read-only t)
charset) charset)
(if (gnus-buffer-live-p gnus-original-article-buffer) (if (gnus-buffer-live-p gnus-original-article-buffer)
(with-current-buffer gnus-original-article-buffer (with-current-buffer gnus-original-article-buffer
...@@ -1794,7 +1794,7 @@ always hide." ...@@ -1794,7 +1794,7 @@ always hide."
(save-excursion (save-excursion
(set-buffer gnus-article-buffer) (set-buffer gnus-article-buffer)
(when (article-goto-body) (when (article-goto-body)
(let* ((buffer-read-only nil) (let* ((inhibit-read-only t)
(start (point)) (start (point))
(end (point-max)) (end (point-max))
(orig (buffer-substring start end)) (orig (buffer-substring start end))
...@@ -1812,7 +1812,7 @@ always hide." ...@@ -1812,7 +1812,7 @@ always hide."
(unless (gnus-article-check-hidden-text 'signature arg) (unless (gnus-article-check-hidden-text 'signature arg)
(save-excursion (save-excursion
(save-restriction (save-restriction
(let ((buffer-read-only nil)) (let ((inhibit-read-only t))
(when (gnus-article-narrow-to-signature) (when (gnus-article-narrow-to-signature)
(gnus-article-hide-text-type (gnus-article-hide-text-type
(point-min) (point-max) 'signature))))))) (point-min) (point-max) 'signature)))))))
...@@ -2001,7 +2001,7 @@ means show, 0 means toggle." ...@@ -2001,7 +2001,7 @@ means show, 0 means toggle."
(defun gnus-article-show-hidden-text (type &optional dummy) (defun gnus-article-show-hidden-text (type &optional dummy)
"Show all hidden text of type TYPE. "Show all hidden text of type TYPE.
Originally it is hide instead of DUMMY." Originally it is hide instead of DUMMY."
(let ((buffer-read-only nil) (let ((inhibit-read-only t)
(inhibit-point-motion-hooks t)) (inhibit-point-motion-hooks t))
(gnus-remove-text-properties-when (gnus-remove-text-properties-when
'article-type type 'article-type type
...@@ -2054,7 +2054,7 @@ should replace the \"Date:\" one, or should be added below it." ...@@ -2054,7 +2054,7 @@ should replace the \"Date:\" one, or should be added below it."
(forward-line 1)) (forward-line 1))
(when (and date (not (string= date ""))) (when (and date (not (string= date "")))
(goto-char (point-min)) (goto-char (point-min))
(let ((buffer-read-only nil)) (let ((inhibit-read-only t))
;; Delete any old Date headers. ;; Delete any old Date headers.
(while (re-search-forward date-regexp nil t) (while (re-search-forward date-regexp nil t)
(if pos (if pos
...@@ -2238,7 +2238,7 @@ This format is defined by the `gnus-article-time-format' variable." ...@@ -2238,7 +2238,7 @@ This format is defined by the `gnus-article-time-format' variable."
"Show all hidden text in the article buffer." "Show all hidden text in the article buffer."
(interactive) (interactive)
(save-excursion (save-excursion
(let ((buffer-read-only nil)) (let ((inhibit-read-only t))
(gnus-article-unhide-text (point-min) (point-max))))) (gnus-article-unhide-text (point-min) (point-max)))))
(defun article-emphasize (&optional arg) (defun article-emphasize (&optional arg)
...@@ -2252,7 +2252,7 @@ This format is defined by the `gnus-article-time-format' variable." ...@@ -2252,7 +2252,7 @@ This format is defined by the `gnus-article-time-format' variable."
gnus-article-emphasis-alist) gnus-article-emphasis-alist)
(error)) (error))
gnus-emphasis-alist)) gnus-emphasis-alist))
(buffer-read-only nil) (inhibit-read-only t)
(props (append '(article-type emphasis) (props (append '(article-type emphasis)
gnus-hidden-properties)) gnus-hidden-properties))
regexp elem beg invisible visible face) regexp elem beg invisible visible face)
...@@ -2837,7 +2837,7 @@ If ALL-HEADERS is non-nil, no headers are hidden." ...@@ -2837,7 +2837,7 @@ If ALL-HEADERS is non-nil, no headers are hidden."
(when (and (boundp 'transient-mark-mode) (when (and (boundp 'transient-mark-mode)
transient-mark-mode) transient-mark-mode)
(setq mark-active nil)) (setq mark-active nil))
(if (not (setq result (let ((buffer-read-only nil)) (if (not (setq result (let ((inhibit-read-only t))
(gnus-request-article-this-buffer (gnus-request-article-this-buffer
article group)))) article group))))
;; There is no such article. ;; There is no such article.
...@@ -3671,7 +3671,7 @@ If given a numerical ARG, move forward ARG pages." ...@@ -3671,7 +3671,7 @@ If given a numerical ARG, move forward ARG pages."
(widen) (widen)
;; Remove any old next/prev buttons. ;; Remove any old next/prev buttons.
(when (gnus-visual-p 'page-marker) (when (gnus-visual-p 'page-marker)
(let ((buffer-read-only nil)) (let ((inhibit-read-only t))
(gnus-remove-text-with-property 'gnus-prev) (gnus-remove-text-with-property 'gnus-prev)
(gnus-remove-text-with-property 'gnus-next))) (gnus-remove-text-with-property 'gnus-next)))
(when (when
...@@ -3686,12 +3686,12 @@ If given a numerical ARG, move forward ARG pages." ...@@ -3686,12 +3686,12 @@ If given a numerical ARG, move forward ARG pages."
(match-beginning 0) (match-beginning 0)
(point))) (point)))
(when (and (gnus-visual-p 'page-marker) (when (and (gnus-visual-p 'page-marker)
(not (= (point-min) 1))) (> (point-min) (save-restriction (widen) (point-min))))
(save-excursion (save-excursion
(goto-char (point-min)) (goto-char (point-min))
(gnus-insert-prev-page-button))) (gnus-insert-prev-page-button)))
(when (and (gnus-visual-p 'page-marker) (when (and (gnus-visual-p 'page-marker)
(< (+ (point-max) 2) (buffer-size))) (< (point-max) (save-restriction (widen) (point-max))))
(save-excursion (save-excursion
(goto-char (point-max)) (goto-char (point-max))
(gnus-insert-next-page-button))))) (gnus-insert-next-page-button)))))
...@@ -4044,7 +4044,7 @@ If given a prefix, show the hidden text instead." ...@@ -4044,7 +4044,7 @@ If given a prefix, show the hidden text instead."
(methods (and (stringp article) (methods (and (stringp article)
gnus-refer-article-method)) gnus-refer-article-method))
result result
(buffer-read-only nil)) (inhibit-read-only t))
(if (or (not (listp methods)) (if (or (not (listp methods))
(and (symbolp (car methods)) (and (symbolp (car methods))
(assq (car methods) nnoo-definition-alist))) (assq (car methods) nnoo-definition-alist)))
...@@ -4140,7 +4140,7 @@ If given a prefix, show the hidden text instead." ...@@ -4140,7 +4140,7 @@ If given a prefix, show the hidden text instead."
"\C-c\C-w" gnus-article-edit-mode-map) "\C-c\C-w" gnus-article-edit-mode-map)
"f" gnus-article-edit-full-stops)) "f" gnus-article-edit-full-stops))
(define-derived-mode gnus-article-edit-mode text-mode "Article Edit" (define-derived-mode gnus-article-edit-mode message-mode "Article Edit"
"Major mode for editing articles. "Major mode for editing articles.
This is an extended text-mode. This is an extended text-mode.
...@@ -4212,7 +4212,7 @@ groups." ...@@ -4212,7 +4212,7 @@ groups."
(gnus-article-edit-exit) (gnus-article-edit-exit)
(save-excursion (save-excursion
(set-buffer buf) (set-buffer buf)
(let ((buffer-read-only nil)) (let ((inhibit-read-only t))
(funcall func arg)) (funcall func arg))
;; The cache and backlog have to be flushed somewhat. ;; The cache and backlog have to be flushed somewhat.
(when gnus-keep-backlog (when gnus-keep-backlog
...@@ -4289,6 +4289,9 @@ groups." ...@@ -4289,6 +4289,9 @@ groups."
("\\bmailto:\\([^ \n\t]+\\)" 0 t gnus-url-mailto 1) ("\\bmailto:\\([^ \n\t]+\\)" 0 t gnus-url-mailto 1)
;; This is how URLs _should_ be embedded in text... ;; This is how URLs _should_ be embedded in text...
("<URL: *\\([^<>]*\\)>" 0 t gnus-button-embedded-url 1) ("<URL: *\\([^<>]*\\)>" 0 t gnus-button-embedded-url 1)
;; Info manual references.
("(\\(info\\|Info-goto-node\\)[ \n\t]+\"\\(([^)\"\n]+)[^\"\n]+\\)\")"
0 t Info-goto-node 2)
;; Raw URLs. ;; Raw URLs.
(,gnus-button-url-regexp 0 t browse-url 0)) (,gnus-button-url-regexp 0 t browse-url 0))
"*Alist of regexps matching buttons in article bodies. "*Alist of regexps matching buttons in article bodies.
...@@ -4296,7 +4299,7 @@ groups." ...@@ -4296,7 +4299,7 @@ groups."
Each entry has the form (REGEXP BUTTON FORM CALLBACK PAR...), where Each entry has the form (REGEXP BUTTON FORM CALLBACK PAR...), where
REGEXP: is the string matching text around the button, REGEXP: is the string matching text around the button,
BUTTON: is the number of the regexp grouping actually matching the button, BUTTON: is the number of the regexp grouping actually matching the button,
FORM: is a lisp expression which must eval to true for the button to FORM: is a Lisp expression which must eval to true for the button to
be added, be added,
CALLBACK: is the function to call when the user push this button, and each CALLBACK: is the function to call when the user push this button, and each
PAR: is a number of a regexp grouping whose text will be passed to CALLBACK. PAR: is a number of a regexp grouping whose text will be passed to CALLBACK.
...@@ -4405,7 +4408,7 @@ do the highlighting. See the documentation for those functions." ...@@ -4405,7 +4408,7 @@ do the highlighting. See the documentation for those functions."
(set-buffer gnus-article-buffer) (set-buffer gnus-article-buffer)
(save-restriction (save-restriction
(let ((alist gnus-header-face-alist) (let ((alist gnus-header-face-alist)
(buffer-read-only nil) (inhibit-read-only t)
(case-fold-search t) (case-fold-search t)
(inhibit-point-motion-hooks t) (inhibit-point-motion-hooks t)
entry regexp header-face field-face from hpoints fpoints) entry regexp header-face field-face from hpoints fpoints)
...@@ -4444,7 +4447,7 @@ It does this by highlighting everything after ...@@ -4444,7 +4447,7 @@ It does this by highlighting everything after
(interactive) (interactive)
(save-excursion (save-excursion
(set-buffer gnus-article-buffer) (set-buffer gnus-article-buffer)
(let ((buffer-read-only nil) (let ((inhibit-read-only t)
(inhibit-point-motion-hooks t)) (inhibit-point-motion-hooks t))
(save-restriction (save-restriction
(when (and gnus-signature-face (when (and gnus-signature-face
...@@ -4469,7 +4472,7 @@ specified by `gnus-button-alist'." ...@@ -4469,7 +4472,7 @@ specified by `gnus-button-alist'."
(interactive (list 'force)) (interactive (list 'force))
(save-excursion (save-excursion
(set-buffer gnus-article-buffer) (set-buffer gnus-article-buffer)
(let ((buffer-read-only nil) (let ((inhibit-read-only t)
(inhibit-point-motion-hooks t) (inhibit-point-motion-hooks t)
(case-fold-search t) (case-fold-search t)
(alist gnus-button-alist) (alist gnus-button-alist)
...@@ -4514,7 +4517,7 @@ specified by `gnus-button-alist'." ...@@ -4514,7 +4517,7 @@ specified by `gnus-button-alist'."
(save-excursion (save-excursion
(set-buffer gnus-article-buffer) (set-buffer gnus-article-buffer)
(save-restriction (save-restriction
(let ((buffer-read-only nil) (let ((inhibit-read-only t)
(inhibit-point-motion-hooks t) (inhibit-point-motion-hooks t)
(case-fold-search t) (case-fold-search t)
(alist gnus-header-button-alist) (alist gnus-header-button-alist)
...@@ -4572,7 +4575,7 @@ specified by `gnus-button-alist'." ...@@ -4572,7 +4575,7 @@ specified by `gnus-button-alist'."
(defun gnus-signature-toggle (end) (defun gnus-signature-toggle (end)
(save-excursion (save-excursion
(set-buffer gnus-article-buffer) (set-buffer gnus-article-buffer)
(let ((buffer-read-only nil) (let ((inhibit-read-only t)
(inhibit-point-motion-hooks t)) (inhibit-point-motion-hooks t))
(if (text-property-any end (point-max) 'article-type 'signature) (if (text-property-any end (point-max) 'article-type 'signature)
(gnus-remove-text-properties-when (gnus-remove-text-properties-when
...@@ -4737,7 +4740,7 @@ forbidden in URL encoding." ...@@ -4737,7 +4740,7 @@ forbidden in URL encoding."
(define-key gnus-prev-page-map "\r" 'gnus-button-prev-page)) (define-key gnus-prev-page-map "\r" 'gnus-button-prev-page))
(defun gnus-insert-prev-page-button () (defun gnus-insert-prev-page-button ()
(let ((buffer-read-only nil)) (let ((inhibit-read-only t))
(gnus-eval-format (gnus-eval-format
gnus-prev-page-line-format nil gnus-prev-page-line-format nil
`(gnus-prev t local-map ,gnus-prev-page-map `(gnus-prev t local-map ,gnus-prev-page-map
...@@ -4768,7 +4771,7 @@ forbidden in URL encoding." ...@@ -4768,7 +4771,7 @@ forbidden in URL encoding."
(select-window win))) (select-window win)))
(defun gnus-insert-next-page-button () (defun gnus-insert-next-page-button ()
(let ((buffer-read-only nil)) (let ((inhibit-read-only t))
(gnus-eval-format gnus-next-page-line-format nil (gnus-eval-format gnus-next-page-line-format nil
`(gnus-next `(gnus-next
t local-map ,gnus-next-page-map t local-map ,gnus-next-page-map
...@@ -4796,8 +4799,8 @@ forbidden in URL encoding." ...@@ -4796,8 +4799,8 @@ forbidden in URL encoding."
"List of methods used to decode headers. "List of methods used to decode headers.
This variable is a list of FUNCTION or (REGEXP . FUNCTION). If item This variable is a list of FUNCTION or (REGEXP . FUNCTION). If item
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
\(REGEXP . FUNCTION), FUNCTION will be only apply to these newsgroups \(REGEXP . FUNCTION), FUNCTION will be only applied to these newsgroups
whose names match REGEXP. whose names match REGEXP.
For example: For example:
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment