Mercurial > hg > xemacs

changeset 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 dd557432d846
children 18db20bcc65b
files lucid/my-news.el shared/common-init.el shared/diary.el shared/gnus-init.el shared/mail-extras.el shared/pers-init.el
diffstat 6 files changed, 129 insertions(+), 182 deletions(-) [+]
line wrap: on
line diff
--- a/lucid/my-news.el	Mon Feb 08 12:29:18 2021 +0000
+++ b/lucid/my-news.el	Sat Sep 17 11:01:40 2022 +0100
@@ -129,7 +129,7 @@
     (search-backward "\n-- \n")
     (when (looking-at "\n-- \n       Henry")
       (forward-char 5)
-      (kill-entire-line 5)
+      (kill-entire-line 6)
       (insert-file "/afs/inf.ed.ac.uk/user/h/ht/.quaker-sig"))))
 
 (defun kill-white ()             
Binary file shared/common-init.el has changed
--- 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)
--- a/shared/gnus-init.el	Mon Feb 08 12:29:18 2021 +0000
+++ b/shared/gnus-init.el	Sat Sep 17 11:01:40 2022 +0100
@@ -130,17 +130,18 @@
 	;(to "sdp-students" "sdp")
 	(to "fnlp-students" "fnlp")
 	;(from "fox@tardis\\.ed\\.ac\\.uk\\|s1505551" "fnlp")
-	(to "anlp-students" "anlp")
+	;(to "anlp-students" "anlp")
 	;(from "nbnotifications" "anlp")
 	;(: split-on-whole-field "Subject" "Re: MSc Project 18.*" "msc18")
-	(: split-on-whole-field "Subject" ".*FNLP.*" "fnlp")
+	(: split-on-whole-field "Subject" ".*\\(FNLP\\|100782021\\).*" "fnlp")
 	;(: split-on-whole-field "Subject" ".*SDP \\(MS .\\|final\\) evaluation" "sdpEval")
 	;(: split-on-whole-field "Subject" ".*[[]SDP[]] \\(Your evaluation\\|Evaluation deadline\\).*" "sdpEval")
 	;(: split-on-whole-field "Subject" ".*SDP.*" "sdp")
-	(: split-on-whole-field "Subject" ".*Welcome to ANLP, action needed.*" "anlp_github")
-	(: split-on-whole-field "Subject" ".*ANLP.*" "anlp")
-	(from "ANLP on Piazza" "anlp")
+	;(: split-on-whole-field "Subject" ".*Welcome to ANLP, action needed.*" "anlp_github")
+	;(: split-on-whole-field "Subject" ".*ANLP.*" "anlp")
+	;(from "ANLP on Piazza" "anlp")
 	;(from "FNLP on Piazza" "fnlp")
+	(from "ititov\\|v.dankers\\|m.m.lindemann" "fnlp")
 	;(from "no-reply@piazza.com" "anlp")
 	(: split-on-whole-field "Subject" ".*Personal Tutor.*" "tutees20")
 	(: split-on-whole-field "Subject" ".*Course Selection.*" "tutees20")
@@ -169,9 +170,9 @@
 	))
 
 (setq sms-list
-      '((from "s1513009@.*" "ug4_18");\\|s1536017\\(s1443062\\|s1679328
+      '(;(from "s1513009@.*" "ug4_18");\\|s1536017\\(s1443062\\|s1679328
 	;(from "Y.Chen-258@.*" "msc_19")
-	(from "\\(s1795066\\|s1825415\\|A.M.Magalhaes\\|T.Makino\\|S.Li-93\\|M.Maggiolo\\|ashe\\|Y.Li-242\\|E.J.Martin\\|K.Lohse\\|D.Li-28\\|S.D.Martin-1\\|K.Chen-35\\|J.Norris-3\\|S.Li-80\\|Y.Liu-236\\|J.Chen-114\\|Q.Zeng-3\\|Y.Liu-244\\|P.Guo-1\\|s1582739\\|B.Lun\\|X.Li-143\\|F.Li-17\\|K.R.Lu\\|Z.Li-86\\)@.*" "tutees18")
+	;(from "\\(s1795066\\|s1825415\\|A.M.Magalhaes\\|T.Makino\\|S.Li-93\\|M.Maggiolo\\|ashe\\|Y.Li-242\\|E.J.Martin\\|K.Lohse\\|D.Li-28\\|S.D.Martin-1\\|K.Chen-35\\|J.Norris-3\\|S.Li-80\\|Y.Liu-236\\|J.Chen-114\\|Q.Zeng-3\\|Y.Liu-244\\|P.Guo-1\\|s1582739\\|B.Lun\\|X.Li-143\\|F.Li-17\\|K.R.Lu\\|Z.Li-86\\)@.*" "tutees18")
 	(from "\\(s1895309\\|s1765180\\|s1764494\\|s1645474\\|s1953043\\|s1651774\\|s1732316\\|s1742667\\)@.*" "tutees20")
 	))
 
@@ -203,7 +204,7 @@
 	;(to "ding" "gnus")
 	;(to "dssslist" "dsssl")
 	;(to "TEI-L" "tei")
-	(to "\\(announcements\\|unicode\\)@unicode.org" "unicode")
+	(to "\\(announcements\\|unicode\\)@.*[.]unicode[.]org" "unicode")
 	;(to "squid-users@lists.squid-cache.org\\|squid-users@squid-cache.org"
 	;    "squid")
 	(to "exist-open" "exist")
@@ -272,21 +273,23 @@
 	(lambda (sres)
 	  (if (or (equal (car sres) "notSPAM")
 		  (equal (car sres) "waSPAM"))
-	      ;; documentation is wrong, no recursion,
-	      ;; so we do it ourselves :-(
-	      (nnmail-split-it ht-compiled-split)
-	    sres))
-	(| (: ad-spam "adverts")
-	   (: white-spam "waSPAM")
-	   ("X-Bogosity" "Yes.*"
-	    (| 
+		;; documentation is wrong, no recursion,
+		;; so we do it ourselves :-(
+		(nnmail-split-it ht-compiled-split)
+	      sres))
+	(| (to "ht\\+d@inf\\.ed\\.ac\\.uk" "_diary")
+	     (: ad-spam "adverts")
+	     (: split-on-whole-field "Subject" ".*=\\?UTF-8.*=[A-F][0-9]=.*\\?=.*" "slSPAM")
+	     (: white-spam "waSPAM")
+	     ("X-Bogosity" "Yes.*"
+	      (| 
 	       (From ".*ed\.ac\.uk" "edSPAM") ; NB From not from
 	       ("X-Spam-Score" "0" "boSPAM")
 	       "bfSPAM"))  
-	   (: split-on-whole-field "X-Spam-Level" "\\*\\*\\*\\*.*"
-	      "saSPAM")
-	   ("X-Spam-Status" "Yes.*" "saSPAM")
-	   "notSPAM")))
+	     (: split-on-whole-field "X-Spam-Level" "\\*\\*\\*\\*.*"
+		"saSPAM")
+	     ("X-Spam-Status" "Yes.*" "saSPAM")
+	     "notSPAM")))
 
 (setq gnus-show-mime t) ; stale
 (setq mml1991-use 'pgg
@@ -298,6 +301,19 @@
 
 (custom-set-faces)
 
+(defun straight-to-diary ()
+  (save-excursion
+    (gnus-group-goto-group "nnml+ht:_diary")
+    (gnus-group-select-group)
+    (while (gnus-summary-first-unread-article)
+      (let ((sco (get-buffer "*Shell Command Output*")))
+	(if sco
+	    (kill-buffer sco)))
+      (gnus-edit-and-move-to-diary '(16 . t)))
+    (gnus-summary-exit)
+    )
+  )
+
 (add-hook 'gnus-group-mode-hook 'gnus-topic-mode)
 
 (add-hook 'gnus-summary-mode-hook 'gnus-summary-mode-fun1)
@@ -387,7 +403,10 @@
 
 (add-hook 'gnus-get-new-news-hook (lambda () (setq ht-gnus-just-read nil)))
 (add-hook 'gnus-after-getting-new-news-hook
-	  (lambda () (message "%s" ht-gnus-just-read)))
+	  (lambda () (progn
+		       (message "%s" ht-gnus-just-read)
+		       (if (member "_diary" ht-gnus-just-read)
+			   (straight-to-diary)))))
 
 (add-hook 'nnml-prepare-save-mail-hook (function ht-gnus-note-save-to-group))
 
--- a/shared/mail-extras.el	Mon Feb 08 12:29:18 2021 +0000
+++ b/shared/mail-extras.el	Sat Sep 17 11:01:40 2022 +0100
@@ -450,6 +450,7 @@
 
 ;; see message-citation-line-function in message.el
 (defun safe-citation ()
+  (use-text-not-html)
   (when message-reply-headers
     (let ((from (mail-header-from message-reply-headers)))
       (cond ((string-match "^\"?\\([^\"]*\\)\"? <.*>$" from)
@@ -459,6 +460,19 @@
 	    (t
 	     (insert "[anon] writes:\n\n"))))))
 
+(defun use-text-not-html (&optional clear)
+  (when (and (if clear (looking-at "<html")
+	       (looking-at "> <html"))
+	     (bufferp (get-buffer "*Shell Command Output*")))
+    ;; replace HTML only with result of my HTML filter
+    (delete-region (point)(mark t))
+    (insert-buffer "*Shell Command Output*")
+    (when (looking-at "piping")
+      (kill-entire-line)
+      (indent-rigidly (point) (mark t) -3)
+      (if (not clear)
+	  (submerge-region (point) (mark t)))))
+  )
 
 (setq message-citation-line-function (function safe-citation))
 
--- a/shared/pers-init.el	Mon Feb 08 12:29:18 2021 +0000
+++ b/shared/pers-init.el	Sat Sep 17 11:01:40 2022 +0100
@@ -98,9 +98,6 @@
     (progn
       (require 'lemacs-compat)))
 
-(if (string-match "^\\(19\\|2\\)" emacs-version)
-    (progn
-      ;; common v19 and ater
       (if window-system
 	  (progn
 	    (add-hook 'sh-mode-hook '(lambda ()
@@ -140,14 +137,6 @@
       (if (string-match "Lucid" emacs-version)
 	  ;; lemacs only goes here
 	  (progn
-	    (if (< emacs-major-version 21)
-		(setq load-path
-		      (append '("/usr/contrib/lib/xemacs/site-lisp/xml"
-				"/usr/contrib/lib/xemacs/site-lisp/psgml")
-			      load-path))
-;	      (pui-add-install-directory
-;	       "/net/sunsite.doc.ic.ac.uk/public/pub/Mirrors/ftp.xemacs.org/pub/xemacs/packages")
-;	      (setq load-path (remove "/usr/contrib/lib/xemacs/xemacs-packages/lisp/gnus/" load-path))
 	      ;; DICE comes here 2012-01-13
 	      (setq package-get-remove-copy nil)
 	      (setq bbdb-north-american-phone-numbers-p nil)
@@ -159,9 +148,9 @@
 	      (setq bbdb-new-nets-always-primary t)
 	      (setq bbdb-file "/disk/scratch/mail/.bbdb")
 	      (setq bbdb-hashtable-size 24203)
-	      (require 'bbdb)
+	      ;(require 'bbdb) @
 	      ;(require 'bbdb-rmail)
-	      (require 'bbdb-com)	; to fix auto-fill
+	      ;(require 'bbdb-com) @	; to fix auto-fill
 	      (fset 'bbdb-auto-fill-function (lambda () t)) ; ditto
 	      (fmakunbound 'bbdb-orig-rmail-expunge)
 	      ;(add-hook 'rmail-mode-hook 'bbdb-insinuate-rmail)
@@ -174,16 +163,16 @@
 		  ;; bbdb-com
 		  (progn
 		    (require 'sendmail)
-		    (defadvice sendmail-pre-abbrev-expand-hook
-		      (before bbdb-rebuilt-all-aliases activate)
-		      (bbdb-rebuilt-all-aliases))))
+		    ;(defadvice sendmail-pre-abbrev-expand-hook @
+		     ; (before bbdb-rebuilt-all-aliases activate)
+		     ; (bbdb-rebuilt-all-aliases))
+                    ))
 	      (defun gnuserv-start-maybe ()
 		(if (not (frame-live-p gnuserv-frame))
 		    (gnuserv-start)))
 ;;;	      (require 'itimer)
 ;;;	      (start-itimer "gsr" 'gnuserv-start-maybe
 ;;;			    1200 1200 nil nil)
-	      )
 
 	    (if window-system
 		(progn
@@ -250,134 +239,29 @@
 	      (let ((scr (selected-frame)))
 					;	    (sit-for 5)
 		(load "ht-rooms.config" nil t)
-;               Formerly, for troutbeck
-; 		(unwind-protect (make-screen-for-room "diary" "0" "+60"))
-; 					;           (sit-for 5)
-; 		(unwind-protect (make-screen-for-room "elisp" "0" "+73"))
-; 					;	    (sit-for 5)
-; 		(unwind-protect (make-screen-for-room "news" "-50" "+85"))
-		;; for ecclerig
-		(unwind-protect (make-screen-for-room "diary" "+1888" "+0"))
-					;           (sit-for 5)
-		(unwind-protect (make-screen-for-room "elisp" "+1888" "+0"))
-					;	    (sit-for 5)
-		(unwind-protect (make-screen-for-room "news" "+1223" "+0"))
-					;           (sit-for 5)
-;		(unwind-protect (make-screen-for-room "mail" "-75" "+98"))
+		;; for ecclerig viewed from paul
+		(if (eq (device-pixel-width (selected-device)) 1920)
+		    (progn
+		      (unwind-protect
+			  (make-screen-for-room "diary" "+1219" "+68"))
+		      (unwind-protect
+			  (make-screen-for-room "elisp" "+1185" "+102"))
+		      (unwind-protect
+			  (make-screen-for-room "news" "+1253" "+34")))
+		  ;; for ecclerig in office
+		  (unwind-protect (make-screen-for-room "diary" "+1888" "+0"))
+		  (unwind-protect (make-screen-for-room "elisp" "+1888" "+0"))
+		  (unwind-protect (make-screen-for-room "news" "+1223" "+0")))
 		(sit-for 1)
 		(delete-frame scr))
-	      (setq ht-default-config (current-window-configuration))))
-	;; vanilla v19 goes here
-	(if window-system
-	    (progn
-	      (defvar ht-frame-parameter-mods 
-		'((font . "-adobe-courier-medium-r-normal--14-*")
-		  (auto-raise . t)
-		  (auto-lower . nil)
-		  (cursor-type . bar)))
-	      ;; if we have X, we have ISO-Latin-1, so
-	      ;; set char codes 128--255 to display as themselves.
-	      (require 'disp-table)
-	      (standard-display-8bit 161 255)
-	      (transient-mark-mode t)
-	      ;; hightlight searching in bold
-	      (setq search-highlight t)
-	      (make-face 'isearch)
-	      (copy-face 'bold 'isearch)
-	      (set-face-underline-p 'region t)
-	      (set-face-background 'region "white")
-	      (set-face-foreground 'region "black")
-	    (setq c++-font-lock-keywords 'undef)
-	    (setq c-font-lock-keywords 'undef)
-	      (modify-frame-parameters
-	       nil
-	       ht-frame-parameter-mods)
-	      (setq default-frame-alist
-		    (append ht-frame-parameter-mods default-frame-alist))
-	      ;; fix cut and paste
-	      (setq interprogram-paste-function nil
-		    interprogram-cut-function nil)
-	      (defun ht-mouse-set-region (click) "set region and primary selection"
-		(interactive "e")
-		(mouse-set-region click)
-		(x-set-selection "PRIMARY" (buffer-substring (point)(mark))))
-	      (defun ht-mouse-drag-region (click)
-		"drag region and set primary selection"
-		(interactive "e")
-		(mouse-drag-region click)
-		(if mark-active
-		    (x-set-selection "PRIMARY" (buffer-substring (point)(mark)))))
-	      (global-set-key [drag-mouse-1] (function ht-mouse-set-region))
-	      (global-set-key [down-mouse-1] (function ht-mouse-drag-region))
-	      (defun ht-mouse-insert-primary (click)
-		"set point and insert primary selection"
-		(interactive "e")
-		(mouse-set-point click)
-		(push-mark nil nil t)
-		(insert (x-selection)))
-	      (global-set-key [mouse-2] (function ht-mouse-insert-primary))
-	      (setq dired-mode-hook
-		  '(lambda ()
-		     (font-lock-mode 1)
-		     (define-key dired-mode-map
-		       [mouse-2] '(lambda (click)
-				    (interactive "e")
-				    (mouse-set-point click)
-				    (dired-advertised-find-file)))))
-
-	      (defun ht-rooms-setup (&optional arg)
-		(interactive)
-		(require 'mail-extras)
-		(require 'diary)
-		(require 'my-news)
-		;; override changed default, except in gnus
-		(setq mail-use-rfc822 nil)
-		(add-hook 'gnus-summary-mode-hook
-			  (function (lambda ()
-				      (make-local-variable 'mail-use-rfc822)
-				      (setq mail-use-rfc822 t))))
-		(let ((scr (selected-frame)))
-		  (load "ht-rooms.config" nil t)
-		  (unwind-protect (make-frame-for-room "elisp" "-25" "-58"))
-		  (unwind-protect (progn
-				    (make-frame-for-room "news" "-50" "-40")
-				    ))
-		  (unwind-protect (progn
-				    (make-frame-for-room "mail" "-75" "-22")
-				    ))
-		  (unwind-protect (progn
-				    (make-frame-for-room
-				     "diary"
-				     "-0"
-				     (concat
-				      "+"
-				      (format
-				       "%d"
-				       (-
-					(cdr
-					 (assoc
-					  'top
-					  (frame-parameters
-					   (cdr
-					    (assoc
-					     "elisp"
-					     frames-table)))))
-					18))))
-				    ))
-		  (make-frame-invisible scr))
-		(setq ht-default-config (current-window-configuration)))))
-	(setq load-path
-		  (append '("/usr/contrib/lib/emacs/lisp/xml"
-			    "/usr/contrib/lib/emacs/lisp/psgml")
-			    load-path)))
+	      (setq ht-default-config (current-window-configuration)))))
+	;; vanilla v19 was here
       (setq sgml-insert-missing-element-comment nil)
       (load "psgml" nil t)
       (load "psgml-edit" nil t)
       (load "xml-hack" nil t)
       (add-hook 'sgml-mode-hook 'sgml-fix-para)
-)
   ;; v18 emacs only was here
-)
 
 (defun ht-rooms-resetup ()
   (interactive)