Mercurial > hg > xemacs
changeset 24:0e5b39d2f8bb
trying to clean up Paul vs. Maritain for Cirrus
| author | ht |
|---|---|
| date | Sat, 07 Oct 2023 10:44:21 +0100 |
| parents | 5738cc494f7f |
| children | 129123962e51 |
| files | common-init.el gnus-init.el misc.el my-news.el pers-init.el |
| diffstat | 5 files changed, 294 insertions(+), 300 deletions(-) [+] |
line wrap: on
line diff
--- a/gnus-init.el Sat Oct 07 10:11:27 2023 +0100 +++ b/gnus-init.el Sat Oct 07 10:44:21 2023 +0100 @@ -20,9 +20,15 @@ gnus-mime-display-multipart-related-as-mixed t gnus-posting-styles `((".*" (signature-file ,mail-signature-file)) - ((header "To" ".*@rsof.hst.name") + ("quaker-2023" (signature-file "/home/ht/.quaker-sig") - (address "ht@rsof.hst.name"))) + (address "ht@rsof.hst.name")) + ("mhmcc-2023" + (signature-file "/home/ht/.mhmcc-sig") + ("Reply-to" "sesam.emh.management@gmail.com") + (name "HST as Convenor SESAM MHMC") + (address "mhmcc@rsof.hst.name") + ("Bcc" "sesam.emh.management@gmail.com"))) gnus-simplify-subject-regexp "^\\(re[:;.]\\| \\|fwd:\\)*" gnus-summary-display-arrow nil gnus-summary-gather-subject-limit nil @@ -39,20 +45,21 @@ (setq nnmail-crosspost nil) (setq nnmail-split-methods 'nnmail-split-fancy) -(setq nnmail-split-fancy +(defun set-nnmail-split-fancy () + (setq nnmail-split-fancy (let ((month (format-time-string "%Y-%m" (current-time)))) (cons '| (append '(("Subject" "testing" "jjunk") - (to "quaker-\\(l\\|spectrum\\)" "quaker") + (to "quaker-\\(l\\|spectrum\\)" "quaker-2022") (to "quaker-b" "quaker-b") - (to "w3c-xml-schema-\\([a-z]+\\)" "xml-schema-\\1") - (to "w3c-xml-\\([a-z]+\\)" "xml-\\1" ) - (to "w3c-archive" "refinement") - (to "w3c-\\(xsl-wg\\|format\\|i18n-ig\\)" "xsl") (to "[cC]ygwin" "cygwin") - (to "ding" "gnus") (from "noreply@mrooms.net" "nayler") - (to "ht@rsof.hst.name" "quaker") + (to "ht@rsof.hst.name" "quaker-2023") + (to "Wardenship@lists.quaker.eu.org" "wardens") + (to "mhmcc@rsof.hst.name" "mhmcc-2023") + ("Envelope-to" "mhmcc@rsof.hst.name" + (| (from "mhmcc@rsof.hst.name" junk) + "mhmcc-2023")) (to "mfw@rsof.hst.name" "7vt") (to "zphdaily" (concat "pers-" month)) (to "inf\\(pg\\|msc\\|teach\\|res\\|staff\\)" "inf-\\1" ) @@ -63,7 +70,14 @@ (concat "group-" (format-time-string "%Y-%m" (current-time)) - "")))))) + ""))))))) + +(set-nnmail-split-fancy) + +(defun set-ht-compiled-split () + (interactive) + (set-nnmail-split-fancy)) + (setq gnus-show-mime t) (defun ht-gnus-summary-delete-forward ()
--- a/misc.el Sat Oct 07 10:11:27 2023 +0100 +++ b/misc.el Sat Oct 07 10:44:21 2023 +0100 @@ -1,224 +1,224 @@ -;; various hacks -;; a compiled version exists! -;; Last edited: Thu Oct 2 16:47:40 1986 - -(provide 'misc) - -(defun - insert-time () - (interactive) - (insert-string (current-time-string))) - -(global-set-key "\et" 'insert-time) - -(defun - note-edit () - (interactive) - (beginning-of-buffer) - (if - (not (search-forward "Last edited: " nil t)) - (progn (insert-string ";; Last edited: ") - (newline) - (forward-char -1)) - (if (not (looking-at "\n")) - (kill-line))) - (insert-time)) - -(global-set-key "\em" 'note-edit) - -(defun save-and-pause() - (interactive) - (save-some-buffers t) - (suspend-emacs)) - -(global-set-key "\C-x." 'save-and-pause) - -(defun fix-comment-line () - "split comment onto enough lines to avoid overflow" - (interactive) - (indent-for-comment) - (end-of-line) - (if (> (current-column) 79) - (progn - (while (> (current-column) 79) - (re-search-backward "[ ]")) - (indent-new-comment-line) - (end-of-line)))) - -(defun fix-all-comments () - "iterate over file with fix-comment-line" - (interactive) - (while (search-forward ";" nil t) - (fix-comment-line))) - -(global-set-key "\e:" 'fix-comment-line) - -(defun grind-file () - "grind all forms in a lisp file" - (interactive) - (beginning-of-buffer) - (while (re-search-forward "^(" nil t) - (beginning-of-line) - (indent-sexp) - (end-of-line))) - -(defun suggest-breaks () - "suggest line breaks to improve indentation" - (interactive) - (set-mark (point)) - (message "Trying to add line breaks to over-long lines . . .") - (let (finished) - (while (not (or finished - (= (point)(point-max)))) - (end-of-line) - (if (> (current-column) 79) - (let* ((left (progn (beginning-of-line) - (re-search-forward "[ ]*") - (current-column))) - (min-pt (point)) - (target (min 69 (/ (+ 79 left) 2)))) - (end-of-line) - (while (and (> (current-column) target) - (> (point) min-pt) - (search-backward " " nil t))) - (if (<= (point) min-pt) - (progn (goto-char min-pt) - (if (search-forward " " nil t) - (backward-char 1) - (message "losing %d %d %d" min-pt left target)))) - (let ((help-form (quote - "y or <space> to break here,n or . or ! to stop, others interpreted")) - (re-probe t) - (char nil)) - (while re-probe - (setq re-probe nil) - (setq char (read-char)) - (cond ((or (= char ??) - (= char help-char)) - (message help-form)) - ((or (= char ?\ ) - (= char ?y)) - (while (looking-at " ") - (delete-char 1)) - (newline-and-indent) - (message - "Trying to add line breaks to over-long lines . . .")) - ((or (= char ?n) - (= char ?\.) - (= char ?\!)) - nil) - ((= char ?f) - (forward-char 1) - (search-forward " ") - (backward-char 1) - (setq re-probe t)) - ((= char ?b) - (search-backward " ") - (setq re-probe t)) - (t (setq unread-command-char char) - (setq finished t)))))) - (forward-line))) - (message "Trying to add line breaks to over-long lines . . . done."))) - -(defun set-left-margin () - (interactive) - (if (and margin-stack - (< (current-column)(car margin-stack))) - (setq margin-stack nil) - (if (> (current-column) left-margin) - (setq margin-stack (cons left-margin margin-stack)))) - (setq left-margin (current-column)) - (set-fill-prefix)) - -(defun pop-left-margin () - (interactive) - (if margin-stack - (progn (setq left-margin (car margin-stack)) - (setq margin-stack (cdr margin-stack))) - (setq left-margin 0)) - (move-to-column left-margin) - (set-fill-prefix)) - -(setq text-mode-hook `(lambda nil (progn ,@ (mapcar (function list) - text-mode-hook)) - (turn-on-auto-fill) - (abbrev-mode 1) - (local-set-key "\C-cl" 'set-left-margin) - (local-set-key "\C-cs" 'submerge-region))) - -(global-set-key "\C-cp" 'pop-left-margin) - -(make-variable-buffer-local 'margin-stack) -(set-default 'margin-stack nil) - -(global-set-key "\^Xn" 'other-window) ; as per emacs - used to be narrow -(global-set-key "\^Xp" 'other-window-up) ; " - -(defun other-window-up (n) - (interactive "p") - (other-window (- (or n 1)))) - -(defun minibuffer-electric-tilde () - ;; by Stig@hackvan.com - (interactive) - (and (eq ?/ (preceding-char)) - (delete-region (point-min) (point))) - (insert ?~)) - - - -;; Created by: Joe Wells, jbw@cs.bu.edu -;; Created on: Fri May 15 13:16:01 1992 -;; Last modified by: Joe Wells, jbw@csd -;; Last modified on: Fri May 15 17:03:28 1992 -;; Filename: backtrace-fix.el -;; Purpose: make backtrace useful when circular structures are on the stack - -(or (fboundp 'original-backtrace) - (fset 'original-backtrace - (symbol-function 'backtrace))) - -(defconst backtrace-junk "\ - original-backtrace() - (condition-case ...) - (let ...) - (save-excursion ...) - (let ...) -") - -(defun circ-backtrace () - "Print a trace of Lisp function calls currently active. -Output stream used is value of standard-output." - (let (err-flag) - (save-excursion - (set-buffer (get-buffer-create " backtrace-temp")) - (buffer-flush-undo (current-buffer)) - (erase-buffer) - (let ((standard-output (current-buffer))) - (condition-case err - (original-backtrace) - (error - (setq error-flag err)))) - (cond (err-flag - (goto-char (point-max)) - (beginning-of-line 1) - ;; don't leave any unbalanced parens lying around - (delete-region (point) (point-max)))) - (goto-char (point-min)) - (search-forward backtrace-junk nil t) - (delete-region (point-min) (point)) - (princ (buffer-substring (point-min) (point-max))))) - nil) - -(defun install-circ-bt () - (fset 'backtrace - (symbol-function 'circ-backtrace))) - -(defvar submerge-prefix "> " - "prefix to submerge quoted text with") - -(defun submerge-region (&optional start end) - "submerge the current region" - (interactive "r") - (let ((fill-prefix submerge-prefix)) - (indent-region start end nil))) +;; various hacks +;; a compiled version exists! +;; Last edited: Thu Oct 2 16:47:40 1986 + +(provide 'misc) + +(defun + insert-time () + (interactive) + (insert-string (current-time-string))) + +(global-set-key "\et" 'insert-time) + +(defun + note-edit () + (interactive) + (beginning-of-buffer) + (if + (not (search-forward "Last edited: " nil t)) + (progn (insert-string ";; Last edited: ") + (newline) + (forward-char -1)) + (if (not (looking-at "\n")) + (kill-line))) + (insert-time)) + +(global-set-key "\em" 'note-edit) + +(defun save-and-pause() + (interactive) + (save-some-buffers t) + (suspend-emacs)) + +(global-set-key "\C-x." 'save-and-pause) + +(defun fix-comment-line () + "split comment onto enough lines to avoid overflow" + (interactive) + (indent-for-comment) + (end-of-line) + (if (> (current-column) 79) + (progn + (while (> (current-column) 79) + (re-search-backward "[ ]")) + (indent-new-comment-line) + (end-of-line)))) + +(defun fix-all-comments () + "iterate over file with fix-comment-line" + (interactive) + (while (search-forward ";" nil t) + (fix-comment-line))) + +(global-set-key "\e:" 'fix-comment-line) + +(defun grind-file () + "grind all forms in a lisp file" + (interactive) + (beginning-of-buffer) + (while (re-search-forward "^(" nil t) + (beginning-of-line) + (indent-sexp) + (end-of-line))) + +(defun suggest-breaks () + "suggest line breaks to improve indentation" + (interactive) + (set-mark (point)) + (message "Trying to add line breaks to over-long lines . . .") + (let (finished) + (while (not (or finished + (= (point)(point-max)))) + (end-of-line) + (if (> (current-column) 79) + (let* ((left (progn (beginning-of-line) + (re-search-forward "[ ]*") + (current-column))) + (min-pt (point)) + (target (min 69 (/ (+ 79 left) 2)))) + (end-of-line) + (while (and (> (current-column) target) + (> (point) min-pt) + (search-backward " " nil t))) + (if (<= (point) min-pt) + (progn (goto-char min-pt) + (if (search-forward " " nil t) + (backward-char 1) + (message "losing %d %d %d" min-pt left target)))) + (let ((help-form (quote + "y or <space> to break here,n or . or ! to stop, others interpreted")) + (re-probe t) + (char nil)) + (while re-probe + (setq re-probe nil) + (setq char (read-char)) + (cond ((or (= char ??) + (= char help-char)) + (message help-form)) + ((or (= char ?\ ) + (= char ?y)) + (while (looking-at " ") + (delete-char 1)) + (newline-and-indent) + (message + "Trying to add line breaks to over-long lines . . .")) + ((or (= char ?n) + (= char ?\.) + (= char ?\!)) + nil) + ((= char ?f) + (forward-char 1) + (search-forward " ") + (backward-char 1) + (setq re-probe t)) + ((= char ?b) + (search-backward " ") + (setq re-probe t)) + (t (setq unread-command-char char) + (setq finished t)))))) + (forward-line))) + (message "Trying to add line breaks to over-long lines . . . done."))) + +(defun set-left-margin () + (interactive) + (if (and margin-stack + (< (current-column)(car margin-stack))) + (setq margin-stack nil) + (if (> (current-column) left-margin) + (setq margin-stack (cons left-margin margin-stack)))) + (setq left-margin (current-column)) + (set-fill-prefix)) + +(defun pop-left-margin () + (interactive) + (if margin-stack + (progn (setq left-margin (car margin-stack)) + (setq margin-stack (cdr margin-stack))) + (setq left-margin 0)) + (move-to-column left-margin) + (set-fill-prefix)) + +(setq text-mode-hook `(lambda nil (progn ,@ (mapcar (function list) + text-mode-hook)) + (turn-on-auto-fill) + (abbrev-mode 1) + (local-set-key "\C-cl" 'set-left-margin) + (local-set-key "\C-cs" 'submerge-region))) + +(global-set-key "\C-cp" 'pop-left-margin) + +(make-variable-buffer-local 'margin-stack) +(set-default 'margin-stack nil) + +(global-set-key "\^Xn" 'other-window) ; as per emacs - used to be narrow +(global-set-key "\^Xp" 'other-window-up) ; " + +(defun other-window-up (n) + (interactive "p") + (other-window (- (or n 1)))) + +(defun minibuffer-electric-tilde () + ;; by Stig@hackvan.com + (interactive) + (and (eq ?/ (preceding-char)) + (delete-region (point-min) (point))) + (insert ?~)) + + + +;; Created by: Joe Wells, jbw@cs.bu.edu +;; Created on: Fri May 15 13:16:01 1992 +;; Last modified by: Joe Wells, jbw@csd +;; Last modified on: Fri May 15 17:03:28 1992 +;; Filename: backtrace-fix.el +;; Purpose: make backtrace useful when circular structures are on the stack + +(or (fboundp 'original-backtrace) + (fset 'original-backtrace + (symbol-function 'backtrace))) + +(defconst backtrace-junk "\ + original-backtrace() + (condition-case ...) + (let ...) + (save-excursion ...) + (let ...) +") + +(defun circ-backtrace () + "Print a trace of Lisp function calls currently active. +Output stream used is value of standard-output." + (let (err-flag) + (save-excursion + (set-buffer (get-buffer-create " backtrace-temp")) + (buffer-flush-undo (current-buffer)) + (erase-buffer) + (let ((standard-output (current-buffer))) + (condition-case err + (original-backtrace) + (error + (setq error-flag err)))) + (cond (err-flag + (goto-char (point-max)) + (beginning-of-line 1) + ;; don't leave any unbalanced parens lying around + (delete-region (point) (point-max)))) + (goto-char (point-min)) + (search-forward backtrace-junk nil t) + (delete-region (point-min) (point)) + (princ (buffer-substring (point-min) (point-max))))) + nil) + +(defun install-circ-bt () + (fset 'backtrace + (symbol-function 'circ-backtrace))) + +(defvar submerge-prefix "> " + "prefix to submerge quoted text with") + +(defun submerge-region (&optional start end) + "submerge the current region" + (interactive "r") + (let ((fill-prefix submerge-prefix)) + (indent-region start end nil)))
--- a/my-news.el Sat Oct 07 10:11:27 2023 +0100 +++ b/my-news.el Sat Oct 07 10:44:21 2023 +0100 @@ -14,6 +14,8 @@ (setq nnml-directory (expand-file-name "/home/ht/mail/Mail")) (setq gnus-message-archive-method '(nnfolder "archive" + ;; the following two are not taking effect, not sure why, answer + ;; _may_ lie in gnus-setup-news... (nnfolder-directory "/home/ht/mail/cpy") (nnfolder-active-file "/home/ht/mail/cpy/active") (nnfolder-get-new-mail nil)
--- a/pers-init.el Sat Oct 07 10:11:27 2023 +0100 +++ b/pers-init.el Sat Oct 07 10:44:21 2023 +0100 @@ -54,7 +54,7 @@ (append '(("/perl/" . perl-mode) ("\\.scm$" . scheme-mode)) auto-mode-alist)) -(setq inferior-lisp-program "/c/Progra~1/ChezSc~1.4/bin/i3nt/petite") +(setq inferior-lisp-program "scheme") ;;; for scheme (put 'letrec 'lisp-indent-function 1) (put 'case 'lisp-indent-function 1) @@ -189,16 +189,45 @@ (if (string-match "Lucid" emacs-version) ;; lemacs only goes here (progn + (message "lem") (setq bbdb-north-american-phone-numbers-p nil) (setq bbdb-use-pop-up nil) + (require 'mail-abbrevs) (require 'bbdb) - (add-hook 'rmail-mode-hook 'bbdb-insinuate-rmail) + ;(require 'bbdb-rmail) + (require 'bbdb-com) ; to fix auto-fill + (setq mail-use-rfc822 nil) + (add-hook 'gnus-summary-mode-hook + (function (lambda () + (make-local-variable 'mail-use-rfc822) + (setq mail-use-rfc822 t)))) + (if (>= emacs-major-version 21) + (progn + (add-hook 'gnus-startup-hook 'bbdb-insinuate-gnus) + (add-hook 'gnus-startup-hook 'bbdb-insinuate-message))) + (fset 'bbdb-auto-fill-function (lambda () t)) ; ditto + (fmakunbound 'bbdb-orig-rmail-expunge) + ;(add-hook 'rmail-mode-hook 'bbdb-insinuate-rmail) (add-hook 'gnus-startup-hook 'bbdb-insinuate-gnus) (add-hook 'mail-setup-hook 'bbdb-insinuate-sendmail) + (setq bbdb-dwim-net-address-allow-redundancy t) (add-hook 'mail-setup-hook 'bbdb-define-all-aliases) (add-hook 'gnus-message-setup-hook 'bbdb-define-all-aliases) - - + (if (not (fboundp 'define-mail-abbrev)) + ;; fix a bug which crashes occasionally -- see also + ;; bbdb-com + (progn + (require 'sendmail) + ;(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 @@ -359,10 +388,10 @@ 18)))) )) (make-frame-invisible scr)) - (setq ht-default-config (current-window-configuration))))) + (setq ht-default-config (current-window-configuration)))))) (setq sgml-insert-missing-element-comment nil) (add-hook 'sgml-mode-hook 'sgml-fix-para) -)) +) ;; v18 emacs only goes here (progn (require 'compress) @@ -374,13 +403,19 @@ (load "ht-rooms.config" nil t) (setq ht-default-config (current-window-configuration))))) +(defun ht-rooms-resetup () + (interactive) + (setq rooms-table nil) + (setq frames-table nil) + (ht-rooms-setup)) + (defun sgml-fix-para () (setq paragraph-separate "</[^>]*>\n\\([ \t]+\\| \\)") (setq paragraph-start "^[ \t]*</?[A-Za-z._-]+[ >]")) -(defun highlight-headers-ht-follow-url-netscape (url) +(defun highlight-headers-ht-follow-url-netscape (url &optional arg) (message "Sending URL to Netscape...") (save-excursion (set-buffer (get-buffer-create "*Shell Command Output*")) @@ -398,63 +433,6 @@ (cd (user-home-directory)) -(defun ht-custom-size () - (interactive) - (site-caseq ((laptop maritain) - (message (format "pw: %s" (device-pixel-width (selected-device)))))) - (if (fboundp 'device-pixel-width) - (let ((pw (device-pixel-width (selected-device))) - (ph (device-pixel-height (selected-device)))) - (cond ((= pw 2048) - ;; we're on a _really_ big external monitor - (set-frame-pixel-size (selected-frame) 900 1050) - (set-frame-position (selected-frame) 0 0)) - ((= pw 1920) - ;; we're on a 27" curved external monitor - (set-frame-pixel-size (selected-frame) 720 980) - (set-frame-position (selected-frame) -8 2)) - ((= pw 1680) - ;; we're on a big external monitor - (font-menu-set-font nil nil 10) - (set-frame-pixel-size (selected-frame) 900 1000) - (set-frame-position (selected-frame) -3 -20)) - ((= pw 1097) - ;; we're on an XPS 13, mag. 300% - (require 'font-menu) - (font-menu-set-font nil nil 9) - (set-frame-pixel-size (selected-frame) 583 583); 80 x 39 - (set-frame-position (selected-frame) -5 -26)) - ((= pw 1536) - ;; we're on an XPS 13, mag. 250% - (require 'font-menu) - (font-menu-set-font nil nil 10) - (set-frame-pixel-size (selected-frame) 670 782); 81 x 49 - (set-frame-position (selected-frame) -5 -26)) - ((= ph 768) - ;; we're on a narrow cinema-ratio laptop - (set-frame-pixel-size (selected-frame) 690 710) - (set-frame-position (selected-frame) -5 -26)) - ((= ph 900) - ;; we're on a cinema-ratio laptop - (set-frame-pixel-size (selected-frame) 800 820) - (set-frame-position (selected-frame) -3 -20)) - ((= pw 1600) - ;; we're on a big external monitor - (set-frame-pixel-size (selected-frame) 900 1120) - (set-frame-position (selected-frame) -3 -20)) - ((= pw 1280) - (cond ((= ph 720) - (set-frame-pixel-size (selected-frame) 700 655) - (set-frame-position (selected-frame) -3 -30)) - (t - (set-frame-pixel-size (selected-frame) 700 960) - (set-frame-position (selected-frame) -3 -20)))))))) +(require 'misc) ; used to be in common-init... (ht-custom-size) - -;;; make dired list directories first -(defadvice dired-insert-directory (before my-dired-insert-directory - (dir-or-list switches &optional wildcard full-p)) - (setq switches (concat switches " --group-directories-first"))) - -(ad-activate 'dired-insert-directory)