Mercurial > hg > xemacs

comparison my-news.el @ 45:65ea96008fe0

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
hacked up some stuff to get rid of useless safelinks.outlook... link wrappers, acquired use-text-not-html from mail-extras
author Henry S. Thompson <ht@inf.ed.ac.uk>
date Wed, 20 Dec 2023 17:59:49 +0000
parents eee08de75336
children 95ba4cc6ffe4
comparison
equal deleted inserted replaced
44:b09e8120dc53 45:65ea96008fe0
388 388
389 (defun message-mode-fun1 () 389 (defun message-mode-fun1 ()
390 (define-key message-mode-map [(control meta q)] 'add-quaker) 390 (define-key message-mode-map [(control meta q)] 'add-quaker)
391 (remove-hook 'message-mode-hook 'message-mode-fun1)) 391 (remove-hook 'message-mode-hook 'message-mode-fun1))
392 392
393 (defvar ht-gnus-just-read nil)
394
395 (defun ht-catchup-and-next-unseen () 393 (defun ht-catchup-and-next-unseen ()
396 (interactive) 394 (interactive)
397 (when (gnus-summary-catchup nil t nil 'fast) 395 (when (gnus-summary-catchup nil t nil 'fast)
398 (gnus-summary-exit) 396 (gnus-summary-exit)
399 (previous-line 1) 397 (previous-line 1)
409 (ht-read-group-unseen-only))))) 407 (ht-read-group-unseen-only)))))
410 408
411 (defun ht-gnus-pers-refresh (n) 409 (defun ht-gnus-pers-refresh (n)
412 (interactive "p") 410 (interactive "p")
413 (let ((gn (concat "nnml+ht:pers-" 411 (let ((gn (concat "nnml+ht:pers-"
414 (format-time-string "%Y-%m" (current-time))))) 412 (format-time-string "%Y-%m" (current-time))))
413 (jr ht-gnus-just-read))
415 (gnus-group-get-new-news) 414 (gnus-group-get-new-news)
416 (let ((nn (gnus-number-of-unseen-articles-in-group gn))) 415 (let ((nn (gnus-number-of-unseen-articles-in-group gn)))
417 (gnus-group-goto-group gn) 416 (gnus-group-goto-group gn)
418 (cond 417 (cond
419 ((> nn 0) 418 ((> nn 0)
424 (goto-char (point-max)) 423 (goto-char (point-max))
425 (previous-line 1)))) 424 (previous-line 1))))
426 (gnus-group-read-group nil t))) 425 (gnus-group-read-group nil t)))
427 (t (goto-char (point-min)) 426 (t (goto-char (point-min))
428 (ht-next-with-unseen 1)))) 427 (ht-next-with-unseen 1))))
429 (message "%s" ht-gnus-just-read)) 428 (message "read: %s" ht-gnus-just-read)
430 ) 429 ))
431 430
432 (defun no-select () 431 (defun no-select ()
433 (if (member gnus-newsgroup-name no-select-groups) 432 (if (member gnus-newsgroup-name no-select-groups)
434 (progn (make-variable-buffer-local 'gnus-auto-select-first) 433 (progn (make-variable-buffer-local 'gnus-auto-select-first)
435 (setq gnus-auto-select-first nil)))) 434 (setq gnus-auto-select-first nil))))
663 (gnus-number-of-unseen-articles-in-group (gnus-group-group-name)))) 662 (gnus-number-of-unseen-articles-in-group (gnus-group-group-name))))
664 663
665 (defun ht-previous-with-unseen (n) 664 (defun ht-previous-with-unseen (n)
666 (interactive "p") 665 (interactive "p")
667 (ht-next-with-unseen (- n))) 666 (ht-next-with-unseen (- n)))
668
669 (defun ht-gnus-note-save-to-group ()
670 (let ((g (caar group-art)))
671 (if (not (member g ht-gnus-just-read))
672 (setq ht-gnus-just-read (cons g ht-gnus-just-read)))))
673 667
674 (defvar ht-stash-directory (concat my-mail-dir "/stash/")) 668 (defvar ht-stash-directory (concat my-mail-dir "/stash/"))
675 669
676 (defun ht-save-part (handle n) 670 (defun ht-save-part (handle n)
677 (let ((sup-type (mm-handle-media-supertype handle)) 671 (let ((sup-type (mm-handle-media-supertype handle))
789 (if (not (fboundp 'orig-message-send-and-exit)) 783 (if (not (fboundp 'orig-message-send-and-exit))
790 (progn 784 (progn
791 (fset 'orig-message-send-and-exit (symbol-function 'message-send-and-exit)) 785 (fset 'orig-message-send-and-exit (symbol-function 'message-send-and-exit))
792 (fset 'message-send-and-exit (symbol-function 'my-message-send-and-exit)))) 786 (fset 'message-send-and-exit (symbol-function 'my-message-send-and-exit))))
793 787
788 ;; see message-citation-line-function in message.el
789 (defun safe-citation ()
790 (use-text-not-html)
791 (when message-reply-headers
792 (let ((from (mail-header-from message-reply-headers)))
793 (cond ((string-match "^\"?\\([^\"]*\\)\"? <.*>$" from)
794 (insert (match-string 1 from) " writes:\n\n"))
795 ((string-match "^\\([^<@]*\\)@" from)
796 (insert (match-string 1 from) " writes:\n\n"))
797 (t
798 (insert "[anon] writes:\n\n"))))))
799
800 (defun use-text-not-html (&optional clear)
801 (when (and (if clear (looking-at "<html")
802 (looking-at "> <html"))
803 (bufferp (get-buffer "*Shell Command Output*")))
804 ;; replace HTML only with result of my HTML filter
805 (delete-region (point)(mark t))
806 (insert-buffer "*Shell Command Output*")
807 (when (looking-at "piping")
808 (kill-entire-line)
809 (indent-rigidly (point) (mark t) -3)
810 (if (not clear)
811 (submerge-region (point) (mark t)))))
812 )
813
814 (setq message-citation-line-function (function safe-citation))
815
816
817 (defvar safelink_pat "https://[a-z0-9.]*safelinks.protection.outlook.com/\\?url=\\(https?%3A%2F%2F[^&<>\"]*\\)[^\"<> ]*")
818
819 (require 'url)
820
821 (defvar url-ok-chars (nconc
822 '(?/ ?& ?% ?+ ?? ?= ?: ?;
823 ?#
824 )
825 url-unreserved-chars))
826
827 (defun unsafelink ()
828 ;; Thanks to Iain Murray for
829 ;; /public/homepages/imurray2/web/code/hacks/unsafelink
830 (let ((url-unreserved-chars url-ok-chars))
831 (while (re-search-forward safelink_pat nil t)
832 (let ((res (match-string 1)))
833 (replace-match "")
834 ;; unhexify uses regex, so trashes match-string :-(
835 (insert (url-hexify-string (url-unhex-string res)))
836 ))
837 ))
838
839 (add-hook 'gnus-article-prepare-hook 'unsafelink)
840
794 (provide 'my-news) 841 (provide 'my-news)