Mercurial > hg > xemacs
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)