diff lisp/gnus/gnus-sum.el @ 111789:f97704487fb3

Merge changes made in Gnus trunk. nnir.el: Batch header retrieval. proto-stream.el: New library to provide protocol-specific TLS/STARTTLS connections for IMAP, NNTP, SMTP, POP3 and similar protocols. nnimap.el (nnimap-open-connection): Use it. proto-stream.el (open-proto-stream): Complete the documentation. nnimap.el (nnimap-open-connection): Check for "OK" from the greeting. nntp.el: Use proto-streams for the relevant connections types. nntp.el (nntp-open-connection): Switch on STARTTLS on supported servers. proto-stream.el (open-proto-stream): Add a way to specify what the end of a command is. proto-stream.el (proto-stream-open-tls): Delete output from openssl if we're using tls.el. proto-stream.el (proto-stream-open-network): If we don't have gnutls-cli or gnutls built in, then don't try to establish a STARTTLS connection. color.el (color-lab->srgb): Fix function call name. proto-stream.el: Fix the syntax in the comment. nntp.el (nntp-open-connection): Fix the STARTTLS command syntax. proto-stream.el (proto-stream-open-starttls): Actually implement the starttls.el STARTTLS. proto-stream.el (proto-stream-always-use-starttls): New variable. proto-stream.el (proto-stream-open-starttls): De-duplicate the starttls code. proto-stream.el (proto-stream-open-starttls): Folded back into the main function. proto-stream.el (proto-stream-command): Refactor out. nnimap.el (nnimap-stream): Change default to `undecided'. nnimap.el (nnimap-open-connection): If `nnimap-stream' is `undecided', try ssl first, and then network. nnimap.el (nnimap-open-connection-1): Respect nnimap-server-port. nnimap.el (nnimap-open-connection): Be more backwards-compatible. proto-stream.el (open-protocol-stream): Renamed from open-proto-stream. proto-stream.el (proto-stream-open-network): When doing opportunistic TLS upgrades we don't really care about the identity of the peer. gnus.texi (Customizing the IMAP Connection): Note the new defaults. gnus.texi (Direct Functions): Note the STARTTLS upgrade. proto-stream.el (proto-stream-open-network): Force starttls.el to use gnutls-cli, since that what we've checked for. proto-stream.el (proto-stream-always-use-starttls): Only default to t if open-gnutls-stream exists. proto-stream.el (proto-stream-open-network): If STARTTLS failed, then just open a normal connection. proto-stream.el (proto-stream-open-network): Wait until the greeting before doing STARTTLS. nnimap.el (nnimap-open-connection-1): Always upgrade to STARTTLS (for backwards compatibility). nnimap.el (nnimap-open-connection-1): Really respect nnimap-server-port. nntp.el (nntp-open-connection): Provide a :success condition. nnimap.el (nnimap-open-connection-1): Ditto. proto-stream.el (proto-stream-open-network): See what the response to the STARTTLS command is. proto-stream.el (proto-stream-open-network): Add some comments. proto-stream.el: Fix example. proto-stream.el (open-protocol-stream): Actually mention the STARTTLS upgrade. nnir.el (nnir-get-active): Skip nnir-ignored-newsgroups when searching. nnir.el (nnir-ignore-newsgroups): Fix default value. nnir.el (nnir-run-gmane): Use mm-delete-duplicates instead of delete-dups that is not available in XEmacs 21.4. mm-util.el (mm-delete-duplicates): Add comment. gnus-sum.el (gnus-summary-delete-article): If delete fails don't change the registry. nnimap.el (nnimap-open-connection-1): w32 open-network-stream doesn't seem to accept strings-with-numbers as port numbers. color.el: fix docstring to use English rather than math notation for intervals. shr.el (shr-find-fill-point): Don't break before apostrophes. nnir.el (nnir-request-move-article): Bail out if no move support in group. color.el (color-rgb->hsv): Fix docstring. nnir.el (nnir-get-active): Improve active list retrieval. shr.el (shr-find-fill-point): Work better for kinsoku chars and apostrophes. gnus-gravatar.el (gnus-gravatar-size): Set gnus-gravatar-size to nil. nnimap.el (nnimap-open-connection-1): Use gnus-string-match-p. nnimap.el (nnimap-open-connection-1): Fix PREAUTH. proto-stream.el (open-protocol-stream): All starttls connections are handled by the network handler. gnus-gravatar.el (gnus-gravatar-insert): Delete unnecessary binding to t of inhibit-read-only since it is inside gnus-with-article-headers. gnus-gravatar.el (gnus-gravatar-transform-address): Use mail-extract-address-components that supports non-ASCII names rather than mail-header-parse-addresses. shr.el (shr-find-fill-point): Don't break line between kinsoku-bol characters. gnus-gravatar.el (gnus-gravatar-insert): Allow LWSP in the middle of names. nnmaildir.el (nnmaildir-request-set-mark): Add article to add-mark funcall. gnus-msg.el: Remove nastygram thing. message.el (message-from-style): Fix comment. message.el (message-user-organization): Do not use gnus-local-organization. gnus.el: Remove gnus-local-organization. rtree.el: New file to handle range trees. nnir.el, gnus-sum.el: Redo the way nnir handles registry updates. rtree.el (rtree-extract): Simplify. gnus-win.el (gnus-configure-windows): Remove Gnus 3.x setting support. gnus-msg.el: Mark gnus-outgoing-message-group as obsolete. gnus.texi (Archived Messages): Remove gnus-outgoing-message-group. gnus-win.el (gnus-configure-frame): Remove old compatibility code. rtree.el (rtree-memq): Rewrite it as a non-recursive function. rtree.el (rtree-add, rtree-delq, rtree-length): Implement. rtree.el (rtree-add): Make code slightly faster. nnir.el: Allow modified summary-line-format in nnir summary buffers.
author Katsumi Yamaoka <yamaoka@jpl.org>
date Thu, 02 Dec 2010 22:21:31 +0000
parents 7bb815042e61
children 6125476aab24
line wrap: on
line diff
--- a/lisp/gnus/gnus-sum.el	Thu Dec 02 20:34:31 2010 +0100
+++ b/lisp/gnus/gnus-sum.el	Thu Dec 02 22:21:31 2010 +0000
@@ -1310,7 +1310,6 @@
 (defvar gnus-article-decoded-p nil)
 (defvar gnus-article-charset nil)
 (defvar gnus-article-ignored-charsets nil)
-(defvar gnus-article-original-subject nil)
 (defvar gnus-scores-exclude-files nil)
 (defvar gnus-page-broken nil)
 
@@ -1336,7 +1335,6 @@
 (defvar gnus-current-copy-group nil)
 (defvar gnus-current-crosspost-group nil)
 (defvar gnus-newsgroup-display nil)
-(defvar gnus-newsgroup-original-name nil)
 
 (defvar gnus-newsgroup-dependencies nil)
 (defvar gnus-newsgroup-adaptive nil)
@@ -1363,6 +1361,16 @@
     (?c (or (mail-header-chars gnus-tmp-header) 0) ?d)
     (?k (gnus-summary-line-message-size gnus-tmp-header) ?s)
     (?L gnus-tmp-lines ?s)
+    (?Z (or ,(macroexpand-all
+	      '(nnir-article-rsv (mail-header-number gnus-tmp-header)))
+	    0) ?d)
+    (?G (or ,(macroexpand-all
+	      '(nnir-article-group (mail-header-number gnus-tmp-header)))
+	    "") ?s)
+    (?g (or ,(macroexpand-all
+	      '(gnus-group-short-name
+		(nnir-article-group (mail-header-number gnus-tmp-header))))
+	    "") ?s)
     (?O gnus-tmp-downloaded ?c)
     (?I gnus-tmp-indentation ?s)
     (?T (if (= gnus-tmp-level 0) "" (make-string (frame-width) ? )) ?s)
@@ -1583,6 +1591,8 @@
     gnus-newsgroup-prepared gnus-summary-highlight-line-function
     gnus-current-article gnus-current-headers gnus-have-all-headers
     gnus-last-article gnus-article-internal-prepare-hook
+    (gnus-summary-article-delete-hook . global)
+    (gnus-summary-article-move-hook . global)
     gnus-newsgroup-dependencies gnus-newsgroup-selected-overlay
     gnus-newsgroup-scored gnus-newsgroup-kill-headers
     gnus-thread-expunge-below
@@ -9731,210 +9741,203 @@
       ;; Set any marks that may have changed in the summary buffer.
       (when gnus-preserve-marks
 	(gnus-summary-push-marks-to-backend article))
-      (let ((gnus-newsgroup-original-name gnus-newsgroup-name)
-	    (gnus-article-original-subject
-	     (mail-header-subject
-	      (gnus-data-header (assoc article (gnus-data-list nil))))))
-	(setq
-	 art-group
-	 (cond
-	  ;; Move the article.
-	  ((eq action 'move)
-	   ;; Remove this article from future suppression.
-	   (gnus-dup-unsuppress-article article)
-	   (let* ((from-method (gnus-find-method-for-group
-				gnus-newsgroup-name))
-		  (to-method (or select-method
-				 (gnus-find-method-for-group to-newsgroup)))
-		  (move-is-internal (gnus-server-equal from-method to-method)))
-	     (gnus-request-move-article
-	      article			; Article to move
-	      gnus-newsgroup-name	; From newsgroup
-	      (nth 1 (gnus-find-method-for-group
-		      gnus-newsgroup-name)) ; Server
-	      (list 'gnus-request-accept-article
-		    to-newsgroup (list 'quote select-method)
-		    (not articles) t)	; Accept form
-	      (not articles)		; Only save nov last time
-	      (and move-is-internal
-		   to-newsgroup		; Not respooling
+      (setq
+       art-group
+       (cond
+	;; Move the article.
+	((eq action 'move)
+	 ;; Remove this article from future suppression.
+	 (gnus-dup-unsuppress-article article)
+	 (let* ((from-method (gnus-find-method-for-group
+			      gnus-newsgroup-name))
+		(to-method (or select-method
+			       (gnus-find-method-for-group to-newsgroup)))
+		(move-is-internal (gnus-server-equal from-method to-method)))
+	   (gnus-request-move-article
+	    article			; Article to move
+	    gnus-newsgroup-name         ; From newsgroup
+	    (nth 1 (gnus-find-method-for-group
+		    gnus-newsgroup-name)) ; Server
+	    (list 'gnus-request-accept-article
+		  to-newsgroup (list 'quote select-method)
+		  (not articles) t)	; Accept form
+	    (not articles)		; Only save nov last time
+	    (and move-is-internal
+		 to-newsgroup		; Not respooling
 					; Is this move internal?
-		   (gnus-group-real-name to-newsgroup)))))
-	  ;; Copy the article.
-	  ((eq action 'copy)
+		 (gnus-group-real-name to-newsgroup)))))
+	;; Copy the article.
+	((eq action 'copy)
+	 (with-current-buffer copy-buf
+	   (when (gnus-request-article-this-buffer article
+						   gnus-newsgroup-name)
+	     (save-restriction
+	       (nnheader-narrow-to-headers)
+	       (dolist (hdr gnus-copy-article-ignored-headers)
+		 (message-remove-header hdr t)))
+	     (gnus-request-accept-article
+	      to-newsgroup select-method (not articles) t))))
+	;; Crosspost the article.
+	((eq action 'crosspost)
+	 (let ((xref (message-tokenize-header
+		      (mail-header-xref (gnus-summary-article-header
+					 article))
+		      " ")))
+	   (setq new-xref (concat (gnus-group-real-name gnus-newsgroup-name)
+				  ":" (number-to-string article)))
+	   (unless xref
+	     (setq xref (list (system-name))))
+	   (setq new-xref
+		 (concat
+		  (mapconcat 'identity
+			     (delete "Xref:" (delete new-xref xref))
+			     " ")
+		  " " new-xref))
 	   (with-current-buffer copy-buf
-	     (when (gnus-request-article-this-buffer article
-						     gnus-newsgroup-name)
-	       (save-restriction
-		 (nnheader-narrow-to-headers)
-		 (dolist (hdr gnus-copy-article-ignored-headers)
-		   (message-remove-header hdr t)))
-	       (gnus-request-accept-article
-		to-newsgroup select-method (not articles) t))))
-	  ;; Crosspost the article.
-	  ((eq action 'crosspost)
-	   (let ((xref (message-tokenize-header
-			(mail-header-xref (gnus-summary-article-header
-					   article))
-			" ")))
-	     (setq new-xref (concat (gnus-group-real-name gnus-newsgroup-name)
-				    ":" (number-to-string article)))
-	     (unless xref
-	       (setq xref (list (system-name))))
-	     (setq new-xref
-		   (concat
-		    (mapconcat 'identity
-			       (delete "Xref:" (delete new-xref xref))
-			       " ")
-		    " " new-xref))
-	     (with-current-buffer copy-buf
-	       ;; First put the article in the destination group.
-	       (gnus-request-article-this-buffer article gnus-newsgroup-name)
-	       (when (consp (setq art-group
-				  (gnus-request-accept-article
-				   to-newsgroup select-method (not articles)
-				   t)))
-		 (setq new-xref (concat new-xref " " (car art-group)
-					":"
-					(number-to-string (cdr art-group))))
-		 ;; Now we have the new Xrefs header, so we insert
-		 ;; it and replace the new article.
-		 (nnheader-replace-header "Xref" new-xref)
-		 (gnus-request-replace-article
-		  (cdr art-group) to-newsgroup (current-buffer) t)
-		 art-group))))))
-	(cond
-	 ((not art-group)
-	  (gnus-message 1 "Couldn't %s article %s: %s"
-			(cadr (assq action names)) article
-			(nnheader-get-report (car to-method))))
-	 ((eq art-group 'junk)
-	  (when (eq action 'move)
-	    (gnus-summary-mark-article article gnus-canceled-mark)
-	    (gnus-message 4 "Deleted article %s" article)
-	    ;; run the delete hook
-	    (run-hook-with-args 'gnus-summary-article-delete-hook
-				action
-				(gnus-data-header
-				 (assoc article (gnus-data-list nil)))
-				gnus-newsgroup-original-name nil
-				select-method)))
-	 (t
-	  (let* ((pto-group (gnus-group-prefixed-name
-			     (car art-group) to-method))
-		 (info (gnus-get-info pto-group))
-		 (to-group (gnus-info-group info))
-		 to-marks)
-	    ;; Update the group that has been moved to.
-	    (when (and info
-		       (memq action '(move copy)))
-	      (unless (member to-group to-groups)
-		(push to-group to-groups))
-
-	      (unless (memq article gnus-newsgroup-unreads)
-		(push 'read to-marks)
-		(gnus-info-set-read
-		 info (gnus-add-to-range (gnus-info-read info)
-					 (list (cdr art-group)))))
-
-	      ;; See whether the article is to be put in the cache.
-	      (let* ((expirable (gnus-group-auto-expirable-p to-group))
-		     (marks (if expirable
-				gnus-article-mark-lists
-			      (delete '(expirable . expire)
-				      (copy-sequence
-				       gnus-article-mark-lists))))
-		     (to-article (cdr art-group)))
-
-		;; Enter the article into the cache in the new group,
-		;; if that is required.
-		(when gnus-use-cache
-		  (gnus-cache-possibly-enter-article
-		   to-group to-article
-		   (memq article gnus-newsgroup-marked)
-		   (memq article gnus-newsgroup-dormant)
-		   (memq article gnus-newsgroup-unreads)))
-
-		(when gnus-preserve-marks
-		  ;; Copy any marks over to the new group.
-		  (when (and (equal to-group gnus-newsgroup-name)
-			     (not (memq article gnus-newsgroup-unreads)))
-		    ;; Mark this article as read in this group.
-		    (push (cons to-article gnus-read-mark)
-			  gnus-newsgroup-reads)
-		    ;; Increase the active status of this group.
-		    (setcdr (gnus-active to-group) to-article)
-		    (setcdr gnus-newsgroup-active to-article))
-
-		  (while marks
-		    (when (eq (gnus-article-mark-to-type (cdar marks)) 'list)
-		      (when (memq article (symbol-value
-					   (intern (format "gnus-newsgroup-%s"
-							   (caar marks)))))
-			(push (cdar marks) to-marks)
-			;; If the other group is the same as this group,
-			;; then we have to add the mark to the list.
-			(when (equal to-group gnus-newsgroup-name)
-			  (set (intern (format "gnus-newsgroup-%s"
-					       (caar marks)))
-			       (cons to-article
-				     (symbol-value
-				      (intern (format "gnus-newsgroup-%s"
-						      (caar marks)))))))
-			;; Copy the marks to other group.
-			(gnus-add-marked-articles
-			 to-group (cdar marks) (list to-article) info)))
-		    (setq marks (cdr marks)))
-
-		  (when (and expirable
-			     gnus-mark-copied-or-moved-articles-as-expirable
-			     (not (memq 'expire to-marks)))
-		    ;; Mark this article as expirable.
-		    (push 'expire to-marks)
-		    (when (equal to-group gnus-newsgroup-name)
-		      (push to-article gnus-newsgroup-expirable))
-		    ;; Copy the expirable mark to other group.
-		    (gnus-add-marked-articles
-		     to-group 'expire (list to-article) info))
-
-		  (when to-marks
-		    (gnus-request-set-mark
-		     to-group (list (list (list to-article) 'add to-marks)))))
-
-		(gnus-dribble-enter
-		 (concat "(gnus-group-set-info '"
-			 (gnus-prin1-to-string (gnus-get-info to-group))
-			 ")"))))
-
-	    ;; Update the Xref header in this article to point to
-	    ;; the new crossposted article we have just created.
-	    (when (eq action 'crosspost)
-	      (with-current-buffer copy-buf
-		(gnus-request-article-this-buffer article gnus-newsgroup-name)
-		(nnheader-replace-header "Xref" new-xref)
-		(gnus-request-replace-article
-		 article gnus-newsgroup-name (current-buffer) t)))
-
-	    ;; run the move/copy/crosspost/respool hook
-	    (let ((header (gnus-data-header
-			   (assoc article (gnus-data-list nil)))))
-	      (mail-header-set-subject header gnus-article-original-subject)
-	      (run-hook-with-args 'gnus-summary-article-move-hook
-				  action
-				  (gnus-data-header
-				   (assoc article (gnus-data-list nil)))
-				  gnus-newsgroup-original-name
-				  to-newsgroup
-				  select-method)))
-
-	  ;;;!!!Why is this necessary?
-	  (set-buffer gnus-summary-buffer)
-
-	  (when (eq action 'move)
-	    (save-excursion
-	      (gnus-summary-goto-subject article)
-	      (gnus-summary-mark-article article gnus-canceled-mark)))))
-	(push article articles-to-update-marks)))
+	     ;; First put the article in the destination group.
+	     (gnus-request-article-this-buffer article gnus-newsgroup-name)
+	     (when (consp (setq art-group
+				(gnus-request-accept-article
+				 to-newsgroup select-method (not articles)
+				 t)))
+	       (setq new-xref (concat new-xref " " (car art-group)
+				      ":"
+				      (number-to-string (cdr art-group))))
+	       ;; Now we have the new Xrefs header, so we insert
+	       ;; it and replace the new article.
+	       (nnheader-replace-header "Xref" new-xref)
+	       (gnus-request-replace-article
+		(cdr art-group) to-newsgroup (current-buffer) t)
+	       art-group))))))
+      (cond
+       ((not art-group)
+	(gnus-message 1 "Couldn't %s article %s: %s"
+		      (cadr (assq action names)) article
+		      (nnheader-get-report (car to-method))))
+       ((eq art-group 'junk)
+	(when (eq action 'move)
+	  (gnus-summary-mark-article article gnus-canceled-mark)
+	  (gnus-message 4 "Deleted article %s" article)
+	  ;; run the delete hook
+	  (run-hook-with-args 'gnus-summary-article-delete-hook
+			      action
+			      (gnus-data-header
+			       (assoc article (gnus-data-list nil)))
+			      gnus-newsgroup-name nil
+			      select-method)))
+       (t
+	(let* ((pto-group (gnus-group-prefixed-name
+			   (car art-group) to-method))
+	       (info (gnus-get-info pto-group))
+	       (to-group (gnus-info-group info))
+	       to-marks)
+	  ;; Update the group that has been moved to.
+	  (when (and info
+		     (memq action '(move copy)))
+	    (unless (member to-group to-groups)
+	      (push to-group to-groups))
+
+	    (unless (memq article gnus-newsgroup-unreads)
+	      (push 'read to-marks)
+	      (gnus-info-set-read
+	       info (gnus-add-to-range (gnus-info-read info)
+				       (list (cdr art-group)))))
+
+	    ;; See whether the article is to be put in the cache.
+	    (let* ((expirable (gnus-group-auto-expirable-p to-group))
+		   (marks (if expirable
+			      gnus-article-mark-lists
+			    (delete '(expirable . expire)
+				    (copy-sequence
+				     gnus-article-mark-lists))))
+		   (to-article (cdr art-group)))
+
+	      ;; Enter the article into the cache in the new group,
+	      ;; if that is required.
+	      (when gnus-use-cache
+		(gnus-cache-possibly-enter-article
+		 to-group to-article
+		 (memq article gnus-newsgroup-marked)
+		 (memq article gnus-newsgroup-dormant)
+		 (memq article gnus-newsgroup-unreads)))
+
+	      (when gnus-preserve-marks
+		;; Copy any marks over to the new group.
+		(when (and (equal to-group gnus-newsgroup-name)
+			   (not (memq article gnus-newsgroup-unreads)))
+		  ;; Mark this article as read in this group.
+		  (push (cons to-article gnus-read-mark)
+			gnus-newsgroup-reads)
+		  ;; Increase the active status of this group.
+		  (setcdr (gnus-active to-group) to-article)
+		  (setcdr gnus-newsgroup-active to-article))
+
+		(while marks
+		  (when (eq (gnus-article-mark-to-type (cdar marks)) 'list)
+		    (when (memq article (symbol-value
+					 (intern (format "gnus-newsgroup-%s"
+							 (caar marks)))))
+		      (push (cdar marks) to-marks)
+		      ;; If the other group is the same as this group,
+		      ;; then we have to add the mark to the list.
+		      (when (equal to-group gnus-newsgroup-name)
+			(set (intern (format "gnus-newsgroup-%s"
+					     (caar marks)))
+			     (cons to-article
+				   (symbol-value
+				    (intern (format "gnus-newsgroup-%s"
+						    (caar marks)))))))
+		      ;; Copy the marks to other group.
+		      (gnus-add-marked-articles
+		       to-group (cdar marks) (list to-article) info)))
+		  (setq marks (cdr marks)))
+
+		(when (and expirable
+			   gnus-mark-copied-or-moved-articles-as-expirable
+			   (not (memq 'expire to-marks)))
+		  ;; Mark this article as expirable.
+		  (push 'expire to-marks)
+		  (when (equal to-group gnus-newsgroup-name)
+		    (push to-article gnus-newsgroup-expirable))
+		  ;; Copy the expirable mark to other group.
+		  (gnus-add-marked-articles
+		   to-group 'expire (list to-article) info))
+
+		(when to-marks
+		  (gnus-request-set-mark
+		   to-group (list (list (list to-article) 'add to-marks)))))
+
+	      (gnus-dribble-enter
+	       (concat "(gnus-group-set-info '"
+		       (gnus-prin1-to-string (gnus-get-info to-group))
+		       ")"))))
+
+	  ;; Update the Xref header in this article to point to
+	  ;; the new crossposted article we have just created.
+	  (when (eq action 'crosspost)
+	    (with-current-buffer copy-buf
+	      (gnus-request-article-this-buffer article gnus-newsgroup-name)
+	      (nnheader-replace-header "Xref" new-xref)
+	      (gnus-request-replace-article
+	       article gnus-newsgroup-name (current-buffer) t)))
+
+	  ;; run the move/copy/crosspost/respool hook
+	  (run-hook-with-args 'gnus-summary-article-move-hook
+			      action
+			      (gnus-data-header
+			       (assoc article (gnus-data-list nil)))
+			      gnus-newsgroup-name
+			      to-newsgroup
+			      select-method))
+
+        ;;;!!!Why is this necessary?
+	(set-buffer gnus-summary-buffer)
+	
+	(when (eq action 'move)
+	  (save-excursion
+	    (gnus-summary-goto-subject article)
+	    (gnus-summary-mark-article article gnus-canceled-mark)))))
+      (push article articles-to-update-marks))
 
     (save-excursion
       (apply 'gnus-summary-remove-process-mark articles-to-update-marks))
@@ -10213,13 +10216,13 @@
 	  ;; The backend might not have been able to delete the article
 	  ;; after all.
 	  (unless (memq (car articles) not-deleted)
-	    (gnus-summary-mark-article (car articles) gnus-canceled-mark))
-	  (let* ((article (car articles))
-		 (ghead  (gnus-data-header
-			  (assoc article (gnus-data-list nil)))))
-	    (run-hook-with-args 'gnus-summary-article-delete-hook
-				'delete ghead gnus-newsgroup-name nil
-				nil))
+	    (gnus-summary-mark-article (car articles) gnus-canceled-mark)
+	    (let* ((article (car articles))
+		   (ghead  (gnus-data-header
+			    (assoc article (gnus-data-list nil)))))
+	      (run-hook-with-args 'gnus-summary-article-delete-hook
+				  'delete ghead gnus-newsgroup-name nil
+				  nil)))
 	  (setq articles (cdr articles))))
       (when not-deleted
 	(gnus-message 4 "Couldn't delete articles %s" not-deleted)))