* 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.
This commit is contained in:
ShengHuo ZHU
parent
09877d5d2f
commit
520aa572f8
4 changed files with 197 additions and 112 deletions
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -1053,11 +1053,12 @@ Initialized from `text-mode-syntax-table.")
|
|||
|
||||
(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 @@ means show, 0 means toggle."
|
|||
'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 @@ If variable `gnus-use-long-file-name' is non-nil, it is
|
|||
">" 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 @@ Argument LINES specifies lines to be scrolled down."
|
|||
(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 @@ specified by `gnus-button-alist'."
|
|||
(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.
|
||||
|
|
|
|||
|
|
@ -468,57 +468,63 @@ always hide."
|
|||
(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 @@ always hide."
|
|||
`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.
|
||||
|
|
|
|||
|
|
@ -974,6 +974,28 @@ Entries without port tokens default to DEFAULTPORT."
|
|||
(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
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue