diff shared/diary.el @ 3:0a81352bd7d0

catch up
author Henry S. Thompson <ht@inf.ed.ac.uk>
date Sat, 17 Sep 2022 11:01:40 +0100
parents 107d592c5f4a
children 8e0e16f4763c
line wrap: on
line diff
--- a/shared/diary.el	Mon Feb 08 12:29:18 2021 +0000
+++ b/shared/diary.el	Sat Sep 17 11:01:40 2022 +0100
@@ -208,7 +208,9 @@
 (defun gnus-edit-and-move-to-diary (&optional no-delete)
   "try to add a date to subject field, move to diary on exit"
   (interactive "P")
-    (when (gnus-group-read-only-p)
+    (let ((flush-shell nil))
+    (when (and (not (and no-delete (cdr no-delete)))
+	       (gnus-group-read-only-p))
       (error "The current newsgroup does not support article editing"))
     ;; Select article if needed.
     (unless (eq (gnus-summary-article-number)
@@ -223,24 +225,44 @@
     (forward-char 4)
     (insert "htcalendar@markup.co.uk")
     (search-forward "------ Start of forwarded")
+    (save-excursion
+      (when (and (bufferp (get-buffer "*Shell Command Output*"))
+		 (not (re-search-forward
+		       "^--0000.*[[:space:]]*Content-Type: text/plain" nil t nil
+		       (get-buffer " *Original Article*")))
+		 (search-forward "<html" nil t))
+	(backward-char 5)
+	(push-mark nil t)
+	(re-search-forward "</html>[[:space:]]*")
+	(exchange-point-and-mark)
+	(use-text-not-html t)
+	(let ((pos (point)))
+	  (when (search-backward "type=text/html" nil t)
+	    (replace-match "type=text/plain")
+	    (goto-char (+ pos 1))))
+	(setq flush-shell t)
+	))
     (let (sublp)
       (save-excursion
-	(let ((try-date
-	       (and
-		(or (re-search-forward "^\r?$" nil 1) t)
-		(re-search-forward
-		 "[0-9][-0-9 ]*[- ][jfmasondJFMASOND][a-zA-Z]*[- 0-9]*"
-		 (save-excursion (search-forward "\n--\n" nil t))
-		 t)
-		(buffer-substring (match-beginning 0)(match-end 0)))))
-	  (goto-char (point-min))
-	  (setq sublp (search-forward "Subject: " nil t))
-	  (delete-region (point)(progn (search-forward "] " nil t)))
-	  (message (format "date: |%s| %s" try-date sublp))
-	  (if (and sublp
-		   try-date)
-	      (progn (set-mark (point))
-		     (insert try-date)))))
+	(goto-char (point-min))
+	(setq sublp (search-forward "Subject: " nil t))
+	(delete-region (point)(progn (search-forward "] " nil t)))
+	(if (not
+	     (looking-at "[123]?[0-9] [JFMASOND][a-z][a-z] (20)?[2-9][0-9] "))
+	    (save-excursion
+	      (let ((try-date
+		     (and
+		      (or (re-search-forward "^\r?$" nil 1) t)
+		      (re-search-forward
+		       "[0-9][-0-9 ]*[- ][jfmasondJFMASOND][a-zA-Z]*[- 0-9]*"
+		       (save-excursion (search-forward "\n--\n" nil t))
+		       t)
+		      (buffer-substring (match-beginning 0)(match-end 0)))))
+		(message (format "date: |%s| %s" try-date sublp))
+		(if (and sublp
+			 try-date)
+		    (progn (set-mark (point))
+			   (insert try-date)))))))
       (make-local-hook 'message-send-hook)
       (if (and no-delete (equal (car no-delete) 16))
 	  (let ((hook '(lambda ()
@@ -249,11 +271,14 @@
 	    (add-hook 'message-send-hook hook nil t)
 	    
 	    (message-send-and-exit)
-	    (if (not (gnus-summary-next-unread-article))
-		(gnus-summary-exit)))
+	    (if (cdr no-delete)
+		;; called directly from splitting an ht+d message...
+		"_doom"
+	      (if (not (gnus-summary-next-unread-article))
+		  (gnus-summary-exit))))
 	(add-hook 'message-send-hook
 		  `(lambda ()
-		     (ht-gnus-cease-edit ',no-delete)
+		     (ht-gnus-cease-edit ',no-delete ',flush-shell)
 					; (gnus-summary-edit-article-done
 					; ,(or (mail-header-references gnus-current-headers) "")
 					; ,(gnus-group-read-only-p) ,gnus-summary-buffer nil)
@@ -262,15 +287,16 @@
 					; (search-forward "\nSubject: " nil t))
 		     )
 		  nil t)
-	(split-window-vertically 6)
+    	(split-window-vertically 6)
 	(other-window 1)
 	(search-forward "\n\n" nil t)
 	(other-window 1)
 	(goto-char sublp)
 	(message "Exiting to buffer, we hope")))
+    )
   )
 
-(defun ht-gnus-cease-edit (&optional no-delete)
+(defun ht-gnus-cease-edit (&optional no-delete flush-shell)
   "check if diary edit, move if so"
   (interactive "P")
   (message "ceasing. . .")
@@ -280,13 +306,17 @@
     )
   (unless no-delete
     (with-current-buffer gnus-summary-buffer
-      (gnus-summary-delete-article)))
+      (gnus-summary-move-article 1 "nnml+ht:_doom")))
   (if (get-buffer "diary.babyl-summary")
       (kill-buffer "diary.babyl-summary"))
   (with-current-buffer "diary.babyl"
     (rmail-mode)
     (save-buffer)
     (ht-rmail-summarise))
+  (if flush-shell
+      (let ((sb (get-buffer "*Shell Command Output*")))
+	(if (bufferp sb)
+	    (kill-buffer sb))))      
   (message "ceased"))
 
 (defun ht-gnus-summary-save-in-diary (&optional filename)