Mercurial > hg > xemacs

comparison shared/diary.el @ 3:0a81352bd7d0

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
catch up
author Henry S. Thompson <ht@inf.ed.ac.uk>
date Sat, 17 Sep 2022 11:01:40 +0100
parents 107d592c5f4a
children 8e0e16f4763c
comparison
equal deleted inserted replaced
2:dd557432d846 3:0a81352bd7d0
206 (insert try-date))))) 206 (insert try-date)))))
207 207
208 (defun gnus-edit-and-move-to-diary (&optional no-delete) 208 (defun gnus-edit-and-move-to-diary (&optional no-delete)
209 "try to add a date to subject field, move to diary on exit" 209 "try to add a date to subject field, move to diary on exit"
210 (interactive "P") 210 (interactive "P")
211 (when (gnus-group-read-only-p) 211 (let ((flush-shell nil))
212 (when (and (not (and no-delete (cdr no-delete)))
213 (gnus-group-read-only-p))
212 (error "The current newsgroup does not support article editing")) 214 (error "The current newsgroup does not support article editing"))
213 ;; Select article if needed. 215 ;; Select article if needed.
214 (unless (eq (gnus-summary-article-number) 216 (unless (eq (gnus-summary-article-number)
215 gnus-current-article) 217 gnus-current-article)
216 (gnus-summary-select-article t)) 218 (gnus-summary-select-article t))
221 (goto-char (point-min)) 223 (goto-char (point-min))
222 (search-forward "^To: " nil t) 224 (search-forward "^To: " nil t)
223 (forward-char 4) 225 (forward-char 4)
224 (insert "htcalendar@markup.co.uk") 226 (insert "htcalendar@markup.co.uk")
225 (search-forward "------ Start of forwarded") 227 (search-forward "------ Start of forwarded")
228 (save-excursion
229 (when (and (bufferp (get-buffer "*Shell Command Output*"))
230 (not (re-search-forward
231 "^--0000.*[[:space:]]*Content-Type: text/plain" nil t nil
232 (get-buffer " *Original Article*")))
233 (search-forward "<html" nil t))
234 (backward-char 5)
235 (push-mark nil t)
236 (re-search-forward "</html>[[:space:]]*")
237 (exchange-point-and-mark)
238 (use-text-not-html t)
239 (let ((pos (point)))
240 (when (search-backward "type=text/html" nil t)
241 (replace-match "type=text/plain")
242 (goto-char (+ pos 1))))
243 (setq flush-shell t)
244 ))
226 (let (sublp) 245 (let (sublp)
227 (save-excursion 246 (save-excursion
228 (let ((try-date 247 (goto-char (point-min))
229 (and 248 (setq sublp (search-forward "Subject: " nil t))
230 (or (re-search-forward "^\r?$" nil 1) t) 249 (delete-region (point)(progn (search-forward "] " nil t)))
231 (re-search-forward 250 (if (not
232 "[0-9][-0-9 ]*[- ][jfmasondJFMASOND][a-zA-Z]*[- 0-9]*" 251 (looking-at "[123]?[0-9] [JFMASOND][a-z][a-z] (20)?[2-9][0-9] "))
233 (save-excursion (search-forward "\n--\n" nil t)) 252 (save-excursion
234 t) 253 (let ((try-date
235 (buffer-substring (match-beginning 0)(match-end 0))))) 254 (and
236 (goto-char (point-min)) 255 (or (re-search-forward "^\r?$" nil 1) t)
237 (setq sublp (search-forward "Subject: " nil t)) 256 (re-search-forward
238 (delete-region (point)(progn (search-forward "] " nil t))) 257 "[0-9][-0-9 ]*[- ][jfmasondJFMASOND][a-zA-Z]*[- 0-9]*"
239 (message (format "date: |%s| %s" try-date sublp)) 258 (save-excursion (search-forward "\n--\n" nil t))
240 (if (and sublp 259 t)
241 try-date) 260 (buffer-substring (match-beginning 0)(match-end 0)))))
242 (progn (set-mark (point)) 261 (message (format "date: |%s| %s" try-date sublp))
243 (insert try-date))))) 262 (if (and sublp
263 try-date)
264 (progn (set-mark (point))
265 (insert try-date)))))))
244 (make-local-hook 'message-send-hook) 266 (make-local-hook 'message-send-hook)
245 (if (and no-delete (equal (car no-delete) 16)) 267 (if (and no-delete (equal (car no-delete) 16))
246 (let ((hook '(lambda () 268 (let ((hook '(lambda ()
247 (ht-gnus-cease-edit nil) 269 (ht-gnus-cease-edit nil)
248 nil t))) 270 nil t)))
249 (add-hook 'message-send-hook hook nil t) 271 (add-hook 'message-send-hook hook nil t)
250 272
251 (message-send-and-exit) 273 (message-send-and-exit)
252 (if (not (gnus-summary-next-unread-article)) 274 (if (cdr no-delete)
253 (gnus-summary-exit))) 275 ;; called directly from splitting an ht+d message...
276 "_doom"
277 (if (not (gnus-summary-next-unread-article))
278 (gnus-summary-exit))))
254 (add-hook 'message-send-hook 279 (add-hook 'message-send-hook
255 `(lambda () 280 `(lambda ()
256 (ht-gnus-cease-edit ',no-delete) 281 (ht-gnus-cease-edit ',no-delete ',flush-shell)
257 ; (gnus-summary-edit-article-done 282 ; (gnus-summary-edit-article-done
258 ; ,(or (mail-header-references gnus-current-headers) "") 283 ; ,(or (mail-header-references gnus-current-headers) "")
259 ; ,(gnus-group-read-only-p) ,gnus-summary-buffer nil) 284 ; ,(gnus-group-read-only-p) ,gnus-summary-buffer nil)
260 ; (switch-to-buffer gnus-summary-buffer))) 285 ; (switch-to-buffer gnus-summary-buffer)))
261 ; (goto-char (point-min)) 286 ; (goto-char (point-min))
262 ; (search-forward "\nSubject: " nil t)) 287 ; (search-forward "\nSubject: " nil t))
263 ) 288 )
264 nil t) 289 nil t)
265 (split-window-vertically 6) 290 (split-window-vertically 6)
266 (other-window 1) 291 (other-window 1)
267 (search-forward "\n\n" nil t) 292 (search-forward "\n\n" nil t)
268 (other-window 1) 293 (other-window 1)
269 (goto-char sublp) 294 (goto-char sublp)
270 (message "Exiting to buffer, we hope"))) 295 (message "Exiting to buffer, we hope")))
296 )
271 ) 297 )
272 298
273 (defun ht-gnus-cease-edit (&optional no-delete) 299 (defun ht-gnus-cease-edit (&optional no-delete flush-shell)
274 "check if diary edit, move if so" 300 "check if diary edit, move if so"
275 (interactive "P") 301 (interactive "P")
276 (message "ceasing. . .") 302 (message "ceasing. . .")
277 (ht-forward-to-Calendar) 303 (ht-forward-to-Calendar)
278 (let ((rmail-summary-redo '(rmail-summary))) 304 (let ((rmail-summary-redo '(rmail-summary)))
279 (gnus-output-to-rmail ht-diary-file-name) 305 (gnus-output-to-rmail ht-diary-file-name)
280 ) 306 )
281 (unless no-delete 307 (unless no-delete
282 (with-current-buffer gnus-summary-buffer 308 (with-current-buffer gnus-summary-buffer
283 (gnus-summary-delete-article))) 309 (gnus-summary-move-article 1 "nnml+ht:_doom")))
284 (if (get-buffer "diary.babyl-summary") 310 (if (get-buffer "diary.babyl-summary")
285 (kill-buffer "diary.babyl-summary")) 311 (kill-buffer "diary.babyl-summary"))
286 (with-current-buffer "diary.babyl" 312 (with-current-buffer "diary.babyl"
287 (rmail-mode) 313 (rmail-mode)
288 (save-buffer) 314 (save-buffer)
289 (ht-rmail-summarise)) 315 (ht-rmail-summarise))
316 (if flush-shell
317 (let ((sb (get-buffer "*Shell Command Output*")))
318 (if (bufferp sb)
319 (kill-buffer sb))))
290 (message "ceased")) 320 (message "ceased"))
291 321
292 (defun ht-gnus-summary-save-in-diary (&optional filename) 322 (defun ht-gnus-summary-save-in-diary (&optional filename)
293 (gnus-eval-in-buffer-window gnus-save-article-buffer 323 (gnus-eval-in-buffer-window gnus-save-article-buffer
294 (save-excursion 324 (save-excursion