Mercurial > emacs
changeset 34727:4b9a7a10deaa
* gnus-util.el (gnus-add-text-properties-when): New function.
(gnus-remove-text-properties-when): Ditto.
* gnus-cite.el (gnus-article-hide-citation): Use them.
(gnus-article-toggle-cited-text): Use them.
* gnus-art.el (gnus-signature-toggle): Use them.
(gnus-article-show-hidden-text): Ditto.
(gnus-article-hide-text): Ditto.
* gnus-art.el (gnus-article-describe-key): Use prompt.
(gnus-article-describe-key-briefly): Ditto.
| author | ShengHuo ZHU <zsh@cs.rochester.edu> |
|---|---|
| date | Wed, 20 Dec 2000 06:13:15 +0000 |
| parents | f36154c87782 |
| children | 49d020898574 |
| files | lisp/gnus/ChangeLog lisp/gnus/gnus-art.el lisp/gnus/gnus-cite.el lisp/gnus/gnus-util.el |
| diffstat | 4 files changed, 197 insertions(+), 112 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/gnus/ChangeLog Wed Dec 20 06:06:28 2000 +0000 +++ b/lisp/gnus/ChangeLog Wed Dec 20 06:13:15 2000 +0000 @@ -1,3 +1,18 @@ +2000-12-20 ShengHuo ZHU <zsh@cs.rochester.edu> + + * gnus-util.el (gnus-add-text-properties-when): New function. + (gnus-remove-text-properties-when): Ditto. + + * gnus-cite.el (gnus-article-hide-citation): Use them. + (gnus-article-toggle-cited-text): Use them. + + * gnus-art.el (gnus-signature-toggle): Use them. + (gnus-article-show-hidden-text): Ditto. + (gnus-article-hide-text): Ditto. + + * gnus-art.el (gnus-article-describe-key): Use prompt. + (gnus-article-describe-key-briefly): Ditto. + 2000-12-19 ShengHuo ZHU <zsh@cs.rochester.edu> * mm-util.el (mm-charset-synonym-alist): Fix a typo.
--- a/lisp/gnus/gnus-art.el Wed Dec 20 06:06:28 2000 +0000 +++ b/lisp/gnus/gnus-art.el Wed Dec 20 06:13:15 2000 +0000 @@ -1053,11 +1053,12 @@ (defsubst gnus-article-hide-text (b e props) "Set text PROPS on the B to E region, extending `intangible' 1 past B." - (add-text-properties b e props) + (gnus-add-text-properties-when 'article-type nil b e props) (when (memq 'intangible props) (put-text-property (max (1- b) (point-min)) b 'intangible (cddr (memq 'intangible props))))) + (defsubst gnus-article-unhide-text (b e) "Remove hidden text properties from region between B and E." (remove-text-properties b e gnus-hidden-properties) @@ -1976,24 +1977,16 @@ 'hidden nil))) -(defun gnus-article-show-hidden-text (type &optional hide) +(defun gnus-article-show-hidden-text (type &optional dummy) "Show all hidden text of type TYPE. -If HIDE, hide the text instead." - (save-excursion - (let ((buffer-read-only nil) - (inhibit-point-motion-hooks t) - (end (point-min)) - beg) - (while (setq beg (text-property-any end (point-max) 'article-type type)) - (goto-char beg) - (setq end (or - (text-property-not-all beg (point-max) 'article-type type) - (point-max))) - (if hide - (gnus-article-hide-text beg end gnus-hidden-properties) - (gnus-article-unhide-text beg end)) - (goto-char end)) - t))) +Originally it is hide instead of DUMMY." + (let ((buffer-read-only nil) + (inhibit-point-motion-hooks t)) + (gnus-remove-text-properties-when + 'article-type type + (point-min) (point-max) + (cons 'article-type (cons type + gnus-hidden-properties))))) (defconst article-time-units `((year . ,(* 365.25 24 60 60)) @@ -2639,6 +2632,8 @@ ">" end-of-buffer "\C-c\C-i" gnus-info-find-node "\C-c\C-b" gnus-bug + "\C-hk" gnus-article-describe-key + "\C-hc" gnus-article-describe-key-briefly "\C-d" gnus-article-read-summary-keys "\M-*" gnus-article-read-summary-keys @@ -3836,26 +3831,58 @@ (switch-to-buffer summary 'norecord)) (setq in-buffer (current-buffer)) ;; We disable the pick minor mode commands. - (if (setq func (let (gnus-pick-mode) - (lookup-key (current-local-map) keys))) + (if (and (setq func (let (gnus-pick-mode) + (lookup-key (current-local-map) keys))) + (functionp func)) (progn (call-interactively func) - (setq new-sum-point (point))) - (ding)) - (when (eq in-buffer (current-buffer)) - (setq selected (gnus-summary-select-article)) - (set-buffer obuf) - (unless not-restore-window - (set-window-configuration owin)) - (when (eq selected 'old) - (article-goto-body) - (set-window-start (get-buffer-window (current-buffer)) - 1) - (set-window-point (get-buffer-window (current-buffer)) - (point))) - (let ((win (get-buffer-window gnus-article-current-summary))) - (when win - (set-window-point win new-sum-point)))))))) + (setq new-sum-point (point)) + (when (eq in-buffer (current-buffer)) + (setq selected (gnus-summary-select-article)) + (set-buffer obuf) + (unless not-restore-window + (set-window-configuration owin)) + (when (eq selected 'old) + (article-goto-body) + (set-window-start (get-buffer-window (current-buffer)) + 1) + (set-window-point (get-buffer-window (current-buffer)) + (point))) + (let ((win (get-buffer-window gnus-article-current-summary))) + (when win + (set-window-point win new-sum-point)))) ) + (switch-to-buffer gnus-article-buffer) + (ding)))))) + +(defun gnus-article-describe-key (key) + "Display documentation of the function invoked by KEY. KEY is a string." + (interactive "kDescribe key: ") + (gnus-article-check-buffer) + (if (eq (key-binding key) 'gnus-article-read-summary-keys) + (save-excursion + (set-buffer gnus-article-current-summary) + (let (gnus-pick-mode) + (push (elt key 0) unread-command-events) + (setq key (if (featurep 'xemacs) + (events-to-keys (read-key-sequence "Describe key: ")) + (read-key-sequence "Describe key: ")))) + (describe-key key)) + (describe-key key))) + +(defun gnus-article-describe-key-briefly (key &optional insert) + "Display documentation of the function invoked by KEY. KEY is a string." + (interactive "kDescribe key: \nP") + (gnus-article-check-buffer) + (if (eq (key-binding key) 'gnus-article-read-summary-keys) + (save-excursion + (set-buffer gnus-article-current-summary) + (let (gnus-pick-mode) + (push (elt key 0) unread-command-events) + (setq key (if (featurep 'xemacs) + (events-to-keys (read-key-sequence "Describe key: ")) + (read-key-sequence "Describe key: ")))) + (describe-key-briefly key insert)) + (describe-key-briefly key insert))) (defun gnus-article-hide (&optional arg force) "Hide all the gruft in the current article. @@ -4509,9 +4536,15 @@ (set-buffer gnus-article-buffer) (let ((buffer-read-only nil) (inhibit-point-motion-hooks t)) - (if (get-text-property end 'invisible) - (gnus-article-unhide-text end (point-max)) - (gnus-article-hide-text end (point-max) gnus-hidden-properties))))) + (if (text-property-any end (point-max) 'article-type 'signature) + (gnus-remove-text-properties-when + 'article-type 'signature end (point-max) + (cons 'article-type (cons 'signature + gnus-hidden-properties))) + (gnus-add-text-properties-when + 'article-type nil end (point-max) + (cons 'article-type (cons 'signature + gnus-hidden-properties))))))) (defun gnus-button-entry () ;; Return the first entry in `gnus-button-alist' matching this place.
--- a/lisp/gnus/gnus-cite.el Wed Dec 20 06:06:28 2000 +0000 +++ b/lisp/gnus/gnus-cite.el Wed Dec 20 06:13:15 2000 +0000 @@ -468,57 +468,63 @@ (gnus-set-format 'cited-closed-text-button t) (save-excursion (set-buffer gnus-article-buffer) - (cond - ((gnus-article-check-hidden-text 'cite arg) - t) - ((gnus-article-text-type-exists-p 'cite) - (let ((buffer-read-only nil)) - (gnus-article-hide-text-of-type 'cite))) - (t (let ((buffer-read-only nil) - (marks (gnus-dissect-cited-text)) + marks (inhibit-point-motion-hooks t) (props (nconc (list 'article-type 'cite) gnus-hidden-properties)) - beg end start) - (while marks - (setq beg nil - end nil) - (while (and marks (string= (cdar marks) "")) - (setq marks (cdr marks))) - (when marks - (setq beg (caar marks))) - (while (and marks (not (string= (cdar marks) ""))) - (setq marks (cdr marks))) - (when marks + (point (point-min)) + found beg end start) + (while (setq point + (text-property-any point (point-max) + 'gnus-callback + 'gnus-article-toggle-cited-text)) + (setq found t) + (goto-char point) + (gnus-article-toggle-cited-text + (get-text-property point 'gnus-data) arg) + (forward-line 1) + (setq point (point))) + (unless found + (setq marks (gnus-dissect-cited-text)) + (while marks + (setq beg nil + end nil) + (while (and marks (string= (cdar marks) "")) + (setq marks (cdr marks))) + (when marks + (setq beg (caar marks))) + (while (and marks (not (string= (cdar marks) ""))) + (setq marks (cdr marks))) + (when marks (setq end (caar marks))) - ;; Skip past lines we want to leave visible. - (when (and beg end gnus-cited-lines-visible) - (goto-char beg) - (forward-line (if (consp gnus-cited-lines-visible) - (car gnus-cited-lines-visible) - gnus-cited-lines-visible)) - (if (>= (point) end) - (setq beg nil) - (setq beg (point-marker)) - (when (consp gnus-cited-lines-visible) - (goto-char end) - (forward-line (- (cdr gnus-cited-lines-visible))) - (if (<= (point) beg) - (setq beg nil) + ;; Skip past lines we want to leave visible. + (when (and beg end gnus-cited-lines-visible) + (goto-char beg) + (forward-line (if (consp gnus-cited-lines-visible) + (car gnus-cited-lines-visible) + gnus-cited-lines-visible)) + (if (>= (point) end) + (setq beg nil) + (setq beg (point-marker)) + (when (consp gnus-cited-lines-visible) + (goto-char end) + (forward-line (- (cdr gnus-cited-lines-visible))) + (if (<= (point) beg) + (setq beg nil) (setq end (point-marker)))))) - (when (and beg end) - ;; We use markers for the end-points to facilitate later - ;; wrapping and mangling of text. - (setq beg (set-marker (make-marker) beg) - end (set-marker (make-marker) end)) - (gnus-add-text-properties beg end props) - (goto-char beg) - (unless (save-excursion (search-backward "\n\n" nil t)) - (insert "\n")) - (put-text-property - (setq start (point-marker)) - (progn + (when (and beg end) + ;; We use markers for the end-points to facilitate later + ;; wrapping and mangling of text. + (setq beg (set-marker (make-marker) beg) + end (set-marker (make-marker) end)) + (gnus-add-text-properties-when 'article-type nil beg end props) + (goto-char beg) + (unless (save-excursion (search-backward "\n\n" nil t)) + (insert "\n")) + (put-text-property + (setq start (point-marker)) + (progn (gnus-article-add-button (point) (progn (eval gnus-cited-closed-text-button-line-format-spec) @@ -526,42 +532,51 @@ `gnus-article-toggle-cited-text (list (cons beg end) start)) (point)) - 'article-type 'annotation) - (set-marker beg (point))))))))) + 'article-type 'annotation) + (set-marker beg (point)))))))) -(defun gnus-article-toggle-cited-text (args) - "Toggle hiding the text in REGION." +(defun gnus-article-toggle-cited-text (args &optional arg) + "Toggle hiding the text in REGION. +ARG can be nil or a number. Positive means hide, negative +means show, nil means toggle." (let* ((region (car args)) (beg (car region)) (end (cdr region)) (start (cadr args)) (hidden - (text-property-any - beg (1- end) - (car gnus-hidden-properties) (cadr gnus-hidden-properties))) + (text-property-any beg (1- end) 'article-type 'cite)) (inhibit-point-motion-hooks t) buffer-read-only) - (funcall - (if hidden - 'remove-text-properties 'gnus-add-text-properties) - beg end gnus-hidden-properties) - (save-excursion - (goto-char start) - (gnus-delete-line) - (put-text-property - (point) - (progn - (gnus-article-add-button - (point) - (progn (eval - (if hidden - gnus-cited-opened-text-button-line-format-spec - gnus-cited-closed-text-button-line-format-spec)) - (point)) - `gnus-article-toggle-cited-text - args) - (point)) - 'article-type 'annotation)))) + (when (or (null arg) + (zerop arg) + (and (> arg 0) (not hidden)) + (and (< arg 0) hidden)) + (if hidden + (gnus-remove-text-properties-when + 'article-type 'cite beg end + (cons 'article-type (cons 'cite + gnus-hidden-properties))) + (gnus-add-text-properties-when + 'article-type nil beg end + (cons 'article-type (cons 'cite + gnus-hidden-properties)))) + (save-excursion + (goto-char start) + (gnus-delete-line) + (put-text-property + (point) + (progn + (gnus-article-add-button + (point) + (progn (eval + (if hidden + gnus-cited-opened-text-button-line-format-spec + gnus-cited-closed-text-button-line-format-spec)) + (point)) + `gnus-article-toggle-cited-text + args) + (point)) + 'article-type 'annotation))))) (defun gnus-article-hide-citation-maybe (&optional arg force) "Toggle hiding of cited text that has an attribution line.
--- a/lisp/gnus/gnus-util.el Wed Dec 20 06:06:28 2000 +0000 +++ b/lisp/gnus/gnus-util.el Wed Dec 20 06:13:15 2000 +0000 @@ -974,6 +974,28 @@ (while (search-backward "\\." nil t) (delete-char 1))))) +(defun gnus-add-text-properties-when + (property value start end properties &optional object) + "Like `gnus-add-text-properties', only applied on where PROPERTY is VALUE." + (let (point) + (while (and start + (setq point (text-property-not-all start end property value))) + (gnus-add-text-properties start point properties object) + (setq start (text-property-any point end property value))) + (if start + (gnus-add-text-properties start end properties object)))) + +(defun gnus-remove-text-properties-when + (property value start end properties &optional object) + "Like `remove-text-properties', only applied on where PROPERTY is VALUE." + (let (point) + (while (and start + (setq point (text-property-not-all start end property value))) + (remove-text-properties start point properties object) + (setq start (text-property-any point end property value))) + (if start + (remove-text-properties start end properties object)))) + (provide 'gnus-util) ;;; gnus-util.el ends here