(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-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.
(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)
'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))
">" 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
(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.
(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.
(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)
`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.
(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
projects / emacs.git / commitdiff