Mercurial > hg > lib > markup
changeset 0:509549c55989
from elsewhere
| author | Henry S. Thompson <ht@inf.ed.ac.uk> |
|---|---|
| date | Tue, 25 May 2021 13:57:42 -0400 |
| parents | |
| children | f005daf4488a |
| files | emacs/compress.el emacs/diary.el emacs/hist.el emacs/mail-extras.el emacs/mdn-extras.el emacs/prompt-for-word.el emacs/repl-comment.el emacs/xml-hack.el |
| diffstat | 8 files changed, 1270 insertions(+), 0 deletions(-) [+] |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/emacs/compress.el Tue May 25 13:57:42 2021 -0400 @@ -0,0 +1,69 @@ +;;; Last edited: Thu Oct 3 12:28:00 1991 +;;; Handle compressed files +;;; adapted by Henry S. Thompson from Miles Bader from ??? +(provide 'compress) + +(defun uncompress-while-visiting () + "Temporary \"major mode\" used for .[gzZ] files, to uncompress the contents. +It then selects a major mode from the uncompressed file name and contents." + (if (and (not (null buffer-file-name)) + (string-match "\\.g?[zZ]$" buffer-file-name)) + (set-visited-file-name + (substring buffer-file-name 0 (match-beginning 0)))) + (message "Uncompressing...") + (let ((buffer-read-only nil)) + (shell-command-on-region (point-min) (point-max) "zcat" t)) + (message "Uncompressing...done") + (set-buffer-modified-p nil) + (normal-mode)) + +(setq auto-mode-alist + (cons '("\\.g?[zZ]$" . uncompress-while-visiting) auto-mode-alist)) + +(defun find-compressed-version () + "Hook to read and uncompress the compressed version of a file." + ;; Just pretend we had visited the compressed file, + ;; and uncompress-while-visiting will do the rest. + (let ((exts '("gz" "z" "Z")) ext found) + (while (and exts (setq ext (car exts)) (not found)) + (if (file-exists-p (concat buffer-file-name "." ext)) + (progn + (setq buffer-file-name (concat buffer-file-name "." ext)) + (insert-file-contents buffer-file-name t) + (goto-char (point-min)) + (setq error nil) + t) + (setq exts (cdr exts)))))) + +(setq find-file-not-found-hooks + (cons 'find-compressed-version find-file-not-found-hooks)) + +(defun compress-again () + "Hook to compress the uncompressed version of a file." + (let ((exts '("gz" "z" "Z")) ext found) + (while (and exts (setq ext (car exts)) (not found)) + (if (file-exists-p (concat buffer-file-name "." ext)) + (let ((here (current-buffer)) + (fake-buffer-file-name (concat buffer-file-name "." ext)) + (require-final-newline nil)) + (set-buffer (get-buffer-create " *compress*")) + (erase-buffer) + (insert-buffer here) + (message "Compressing...") + (shell-command-on-region (point-min) (point-max) + (if (equal "Z" ext) + "compress" + "gzip") t) + (message "Compressing...done") + (write-region (point-min)(point-max) fake-buffer-file-name) + (bury-buffer (current-buffer)) + (set-buffer here) + (set-buffer-modified-p nil) + (setq found t) + t) + (setq exts (cdr exts)))) + found)) + + +(setq write-file-hooks (cons 'compress-again write-file-hooks)) +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/emacs/diary.el Tue May 25 13:57:42 2021 -0400 @@ -0,0 +1,341 @@ +;; Last edited: Wed Oct 24 17:08:20 1990 +;; provide a simple diary facility on top of rmailsum +;; Copyright (C) 1990 Henry S. Thompson + +;; This file is part of GNU Emacs. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY. No author or distributor +;; accepts responsibility to anyone for the consequences of using it +;; or for whether it serves any particular purpose or works at all, +;; unless he says so in writing. Refer to the GNU Emacs General Public +;; License for full details. + +;; Everyone is granted permission to copy, modify and redistribute +;; GNU Emacs, but only under the conditions described in the +;; GNU Emacs General Public License. A copy of this license is +;; supposed to have been given to you along with GNU Emacs so you +;; can know your rights and responsibilities. It should be in a +;; file named COPYING. Among other things, the copyright notice +;; and this notice must be preserved on all copies. + +(provide 'diary) +(require 'mail-extras) + +(autoload 'sort-subr "sort") + +(defvar ht-diary-file-name "~/DIARY.babyl" + "default name of diary file") + +(defvar ht-Calendar-directory "~/Calendar") + +(defun xxx-date-lessp (date1 date2) + "Return T if DATE1 is earlyer than DATE2." + (string-lessp (gnus-comparable-date date1) + (gnus-comparable-date date2))) + +(defun xxx-comparable-date (date) + "Make comparable string by string-lessp from DATE." + (let ((month '(("JAN" . " 1")("FEB" . " 2")("MAR" . " 3") + ("APR" . " 4")("MAY" . " 5")("JUN" . " 6") + ("JUL" . " 7")("AUG" . " 8")("SEP" . " 9") + ("OCT" . "10")("NOV" . "11")("DEC" . "12"))) + (date (or date ""))) + ;; Can understand the following styles: + ;; (1) 14 Apr 89 03:20:12 GMT + ;; (2) Fri, 17 March 89 4:01:33 GMT + (if (string-match + "\\([0-9]+\\) \\([^ ,]+\\) \\([0-9]+\\) *\\([0-9:]*\\)" date) + (concat + ;; Year + (substring date (match-beginning 3) (match-end 3)) + ;; Month + (cdr + (assoc + (upcase (substring date + (match-beginning 2) + (+ 3 (match-beginning 2)))) + month)) + ;; Day + (format "%2d" (string-to-int + (substring date + (match-beginning 1) (match-end 1)))) + ;; Time + (substring date (match-beginning 4) (match-end 4))) + ;; Cannot understand DATE string. + date + ) + )) + +(defun update-default-diary (arg) "update a diary - with arg, the one for +this file. Without arg, the default (named in ht-diary-file-name)" + (interactive "P") + (if arg + (update-diary (current-buffer)) + (require-diary) + (update-diary (get-file-buffer ht-diary-file-name)))) + +(defun update-diary (buffer) +;; (setq rmail-summary-buffer (get-buffer-create "*Diary*")) + (let ((obuf (current-buffer))) + (set-buffer buffer) + (if (not has-diary-summary) + (progn (make-local-variable 'has-diary-summary) + (setq has-diary-summary t))) + (rmail-summary) + (set-buffer obuf))) + +(defun do-diary-update () "rmail-summary-mode-hook calls this" + (if (save-excursion (set-buffer rbuf) + has-diary-summary) + (progn + (make-local-variable 'diary-summary-buffer) + (setq diary-summary-buffer t) + (setq description (concat "Diary " description)) + (setq buffer-read-only nil) + (sort-diary-hdrs) + (format-diary-hdrs) + (setq buffer-read-only t) + (not-modified) + (beginning-of-buffer) + (setq mesg nil) ; to go to earliest, not first in file + ))) + +(defun require-diary () + (if (not (get-file-buffer ht-diary-file-name)) + (progn (rmail-input ht-diary-file-name) + (rmail-show-message 1)) + )) + +(defvar diary-summary-buffer nil "flag to identify diary summaries") +(defvar has-diary-summary nil "flag to identify buffers with diary summaries") + +(defun sort-diary-hdrs () + (interactive) + (goto-char (point-min)) + (sort-subr nil 'forward-line 'end-of-line 'get-diary-hdr-date nil)) + +(defun format-diary-hdrs () + (goto-char (point-min)) + (while (< (point)(point-max)) + (forward-char 5) + (delete-char 35) + (looking-at " *\\([0-9]*\\) *\\([a-zA-Z]*\\) *\\([0-9]*\\) *\\([0-9]*\\)") + (if (match-beginning 0) + (let ((day (buffer-substring (match-beginning 1)(match-end 1))) + (month (capitalize (buffer-substring (match-beginning 2) + (min (+ (match-beginning 2) + 3) + (match-end 2))))) + (year (buffer-substring (max + (- (match-end 3) 2) + (match-beginning 3)) + (match-end 3))) + (time (buffer-substring (match-beginning 4)(match-end 4)))) + (delete-char (+ 1 + (if (= (match-end 4) + (match-beginning 4)) + 0 ; fix for no time case + 1) + (- (match-end 4)(match-beginning 1)))) + (insert (format " %2s %3s %2s %4s " day month year time)))) + (forward-line 1)) + (goto-char (point-min))) + +(defun get-diary-hdr-date () + (looking-at " *[^ ]* *[^ ]* *[^ ]* *\\(.*\\)$") + (xxx-comparable-date (buffer-substring (match-beginning 1)(match-end 1)))) + + +(if (not (boundp 'rmail-edit-map)) + (load-library "rmailedit")) +(if (not (boundp 'rmail-summary-mode-map)) + (progn (load-library "rmailsum") + (rmail-summary-mode-fun1))) +(define-key rmail-edit-map "\C-c\C-c" 'ht-rmail-cease-edit) +(define-key rmail-edit-map "\C-c\C-]" 'ht-rmail-abort-edit) +;(defvar diary-mode-map (copy-keymap rmail-summary-mode-map)) +;(define-key diary-mode-map "s" 'diary-save) +(define-key rmail-mode-map "h" 'ht-rmail-summarise) +(setq rmail-summary-mode-hook 'do-diary-update) + +(defvar editing-diary-entry nil) + +(defun diary-save () + "save parent file and update" + (interactive) + (set-buffer rmail-buffer) + (rmail-expunge-and-save) + (if has-diary-summary (update-diary (current-buffer)))) + +(defun ht-rmail-summarise () + "Display a summary of all messages, one line per message. +If file is named as ht-diary-file-name, or the summary buffer is already +a diary summary, make it a Diary summary (see +\\[describe-mode] rmail-summary-mode for info)." + (interactive) + (if (eq (current-buffer) + (get-file-buffer ht-diary-file-name)) + (update-default-diary t) + (rmail-summary))) + +(defun edit-and-move-to-diary () + "try to add a date to subject field, move to diary on exit" + (interactive) + (make-local-variable 'editing-diary-entry) + (setq editing-diary-entry t) + (rmail-edit-current-message) + (goto-char (point-min)) + (search-forward "\n\n") + (let ((try-date (and + (re-search-forward + "[0-9][-0-9 ]*[- ][a-zA-Z][a-zA-Z]*[- 0-9]*" nil t) + (buffer-substring (match-beginning 0)(match-end 0))))) + (goto-char (point-min)) + (if (and (search-forward "Subject: " nil t) + try-date) + (progn (set-mark (point)) + (insert try-date))))) + +;; private copy to simulate hook +(defun ht-rmail-cease-edit () + "check if diary edit, move if so" + (interactive) + (rmail-cease-edit) + (if editing-diary-entry + (progn (setq editing-diary-entry nil) + (ht-output-to-Calendar) + (rmail-output-to-rmail-file ht-diary-file-name 1) + (ht-rmail-delete-forward)))) + +;; try to add a diary subject field line to the appropriate caleendar file +(defun ht-output-to-Calendar () + (goto-char (point-min)) + (search-forward "Subject: ") + (or (looking-at + "\\([0-9]+\\) \\([A-Za-z]+\\) \\([0-9]+\\) \\([0-9:]*\\) ?\\(.*\\)\n") + (error "not a recognisable diary line")) + (let ((day (buffer-substring (match-beginning 1) (match-end 1))) + (month (buffer-substring (match-beginning 2) (match-end 2))) + (year (buffer-substring (match-beginning 3) (match-end 3))) + (time (buffer-substring (match-beginning 4) (match-end 4))) + (message (buffer-substring (match-beginning 5) (match-end 5))) + (mb (match-beginning 4)) + (me (match-end 5)) + t-month ends) + (if (file-exists-p ht-Calendar-directory) + (let* ((year (if (string-match "^19" year) + year + (concat "19" year))) + (dfn (concat ht-Calendar-directory + "/xy" + year + "/xc" + day + (setq t-month (capitalize + (substring month 0 3))) + year)) + (buf (find-file-noselect dfn))) + (save-excursion + (set-buffer buf) + (goto-char (point-max)) + (if (not (bolp)) + (insert "\n")) + (if time + (insert time " ")) + (if (string-match " -- \\(.*\\)$" message) + (progn + (setq ends (substring message (match-beginning 1) + (match-end 1))) + (setq message (substring message 0 (match-beginning 0))))) + (insert message) + (let ((require-final-newline nil)) + (save-buffer))) + (if ends + ;; an end date also given + (if (string-match "\\([0-9]+\\) \\([A-Za-z]+\\)" ends) + (let ((e-day (substring ends (match-beginning 1) + (match-end 1))) + (e-month (substring ends (match-beginning 2) + (match-end 2))) + t-e-month msg) + (setq msg (concat + (substring message 0 + (string-match " " message)) + " continues")) + (if (string-equal (setq t-e-month + (capitalize + (substring e-month 0 3))) + t-month) + (fill-dates year t-month (1+ (car + (read-from-string day))) + (car + (read-from-string e-day)) + msg) + (fill-dates year t-month (1+ (car + (read-from-string day))) + (cdr (assoc t-month + '(("Jan" . 31) + ("Feb" . 28) + ("Mar" . 31) + ("Apr" . 30) + ("May" . 31) + ("Jun" . 30) + ("Jul" . 31) + ("Aug" . 31) + ("Sep" . 30) + ("Oct" . 31) + ("Nov" . 30) + ("Dec" . 31)))) + msg) + (fill-dates year t-e-month 1 + (car (read-from-string e-day)) + msg))) + (message "\C-g\C-gCouldn't parse end date: %s" ends))) + )))) + +(defun fill-dates (year month start end mesg) + "fill the dates between start and end with message in the calendar" + (let ((day start)) + (while (<= day end) + (let* ((dfn (concat ht-Calendar-directory + "/xy" + year + "/xc" + day + month + year)) + (buf (find-file-noselect dfn))) + (save-excursion + (set-buffer buf) + (goto-char (point-max)) + (if (not (bolp)) + (insert "\n")) + (insert mesg) + (let ((require-final-newline nil)) + (save-buffer)))) + (setq day (1+ day))))) + +;; private copy +(defun ht-rmail-abort-edit () + "add a hook" + (interactive) + (setq editing-diary-entry nil) + (rmail-abort-edit)) + +(defun rmail-edit-current-message () + "Edit the contents of this message." + (interactive) + (rmail-edit-mode) + (make-local-variable 'rmail-old-text) + (setq rmail-old-text (buffer-substring (point-min) (point-max))) + (setq buffer-read-only nil) + (set-buffer-modified-p (buffer-modified-p)) + ;; Make mode line update. + (if (and (eq (key-binding "\C-c\C-c") 'ht-rmail-cease-edit) + (eq (key-binding "\C-c\C-]") 'ht-rmail-abort-edit)) + (if editing-diary-entry + (message "Editing: Type C-c C-c to move to diary and return to Rmail, C-c C-] to abort") + (message "Editing: Type C-c C-c to return to Rmail, C-c C-] to abort")) + (message (substitute-command-keys + "Editing: Type \\[rmail-cease-edit] to return to Rmail, \\[rmail-abort-edit] to abort"))))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/emacs/hist.el Tue May 25 13:57:42 2021 -0400 @@ -0,0 +1,161 @@ +;;; a tcsh-type history key facility for sub-shells +;; Last edited: Wed Nov 14 09:52:12 1990 + +(provide 'hist) +(require 'prompt-for-word) + +(defvar hk-last-mb nil "*begin of last hk match") + +(defvar hk-last-mark nil "*beginning of last hk insertion") + +(defvar hk-search-pat nil "*regexp for hk search") + +(defvar hk-last-point 0 "*end of last hk insertion") + +(defvar hkr-last-point 0 "*end of last hk pattern search insertion") + +(defvar hkr-search-pat nil "*regexp for hk user pattern search") + +(defvar hk-last-user-pat nil "*user part of last pattern search") + +(make-local-variable 'hk-last-mb) +(make-local-variable 'hk-last-mark) +(make-local-variable 'hk-last-point) +(make-local-variable 'hk-search-pat) +(make-local-variable 'hkr-search-pat) +(make-local-variable 'hkr-last-point) +(make-local-variable 'hk-last-user-pat) + +(defvar hk-pat-table '(("*shell*" . ".*: ") + ("*prolog*" . "| \\?- ") + ("*lisp*" . ">") + ("*inferior-lisp*" . ">")) + "default crux of prompt pattern, by buffer name") + +(defun hist-key (&optional rpt) + "offer a previous input, a la tcsh ^P" + (interactive "p") + (if (not rpt) (setq rpt 1)) + (let ((here (point)) + (pat (or hk-search-pat + (setq hk-search-pat + (concat "^" (or (cdr (assoc (buffer-name + (current-buffer)) + hk-pat-table)) + "") + "\\(.+\\)$"))))) + (hk-find-b rpt here pat))) + +(defun hk-find-b (rpt here pat) + "search backwards for pat, no dups, rpt times" + (while (> rpt 0) + (goto-char (if (= (point) hk-last-point) + hk-last-mb + (if (eobp) + (progn (beginning-of-line) + (setq hk-last-mark nil) + (point)) + (error "nowhere??")))) + (let ((keep-trying t)) + (while keep-trying + (if (re-search-backward pat nil t) + (let ((entry (buffer-substring (match-beginning 1) + (match-end 1)))) + (setq hk-last-mb (match-beginning 0)) + (goto-char (or hk-last-mark here)) + (if (looking-at (regexp-quote entry)) + (goto-char hk-last-mb) + (setq keep-trying nil) + (if hk-last-mark (delete-region hk-last-mark hk-last-point)) + (setq hk-last-mark (point)) + (push-mark (point) t) + (insert entry) + (setq hk-last-point (point)))) + (unwind-protect (error "no more??") + (goto-char (if hk-last-mark + hk-last-point + here)))))) + (setq rpt (1- rpt)))) + +(defun hist-key-back (&optional rpt) + "offer a previous input, a la tcsh ^N" + (interactive "p") + (if (not rpt) (setq rpt 1)) + (let ((here (point)) + (pat (or hk-search-pat + (error "no pattern")))) + (while (> rpt 0) + (goto-char (if (= (point) hk-last-point) + hk-last-mb + (error "lost context"))) + (let ((keep-trying t)) + (while keep-trying + (end-of-line) + (if (re-search-forward pat nil t) + (let ((entry (buffer-substring (match-beginning 1) + (match-end 1)))) + (setq hk-last-mb (match-beginning 0)) + (goto-char (or hk-last-mark here)) + (if (looking-at (regexp-quote entry)) + ;; allow for back to square one + (if (progn (end-of-line) + (eobp)) + (progn (setq keep-trying nil) + (if hk-last-mark + (delete-region hk-last-mark hk-last-point) + (error "shouldnt")) + (goto-char hk-last-mark)) + (goto-char hk-last-mb)) + (setq keep-trying nil) + (if hk-last-mark (delete-region hk-last-mark hk-last-point)) + (setq hk-last-mark (point)) + (push-mark (point) t) + (insert entry) + (setq hk-last-point (point)))) + (unwind-protect (error "no more??") + (goto-char (if hk-last-mark + hk-last-point + here)))))) + (setq rpt (1- rpt))))) + +(defun hist-key-search (&optional rpt pat) + "offer a previous input, searching backwards for a pattern" + (interactive "p") + (if (not rpt) (setq rpt 1)) + (let ((here (point)) + (full-pat + (if (= (point) hkr-last-point) + hkr-search-pat + (setq hkr-search-pat + (if (eobp) + (concat "^" + (or (cdr (assoc (buffer-name + (current-buffer)) + hk-pat-table)) + "") + "\\(.*" + (setq hk-last-user-pat + (or pat + (regexp-quote + (prompt-for-word + "Pattern: " + (or hk-last-user-pat "") + nil nil)))) + ".*\\)$") + (error "nowhere??")))))) + (hk-find-b rpt here full-pat) + (setq hkr-last-point hk-last-point))) + +(require 'shell) + +(define-key shell-mode-map "\ep" 'hist-key) +(define-key shell-mode-map "\en" 'hist-key-back) +(define-key shell-mode-map "\es" 'hist-key-search) +(define-key shell-mode-map "\e\C-i" 'shell-expand-file-name) + +;;; hack in case we've been given com-int +(if (not (boundp 'inferior-lisp-mode-map)) + (require 'inf-lisp)) +(define-key inferior-lisp-mode-map "\ep" 'hist-key) +(define-key inferior-lisp-mode-map "\en" 'hist-key-back) +;; note that prolog copies shell-mode-map, so no need to fix that
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/emacs/mail-extras.el Tue May 25 13:57:42 2021 -0400 @@ -0,0 +1,429 @@ +;; Last edited: Fri Nov 2 10:26:24 1990 +;; extra widgets for rmail and rmailsum +;; Copyright (C) 1990 Henry S. Thompson + +;; This file is part of GNU Emacs. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY. No author or distributor +;; accepts responsibility to anyone for the consequences of using it +;; or for whether it serves any particular purpose or works at all, +;; unless he says so in writing. Refer to the GNU Emacs General Public +;; License for full details. + +;; Everyone is granted permission to copy, modify and redistribute +;; GNU Emacs, but only under the conditions described in the +;; GNU Emacs General Public License. A copy of this license is +;; supposed to have been given to you along with GNU Emacs so you +;; can know your rights and responsibilities. It should be in a +;; file named COPYING. Among other things, the copyright notice +;; and this notice must be preserved on all copies. + +(provide 'mail-extras) +(require 'rmail) +(require 'sendmail) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; mods and fixes for reading mail ;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defvar ht-last-file (expand-file-name "~/XMAIL") + "default for moving mail to") +(make-variable-buffer-local 'ht-last-file) + +(defvar rmht-always-recompress t + "If non-nil, when saving into compressed babyl file, +always recompress and save immediately") + +(defvar rmht-allow-autosave t + "if non-nil, leaves autosave alone for compressed babyl files, +otherwise turns it off") + +(add-hook 'rmail-mode-hook 'rmail-mode-fun1) +(add-hook 'rmail-mode-hook 'rmail-mode-fun2) + +;; run the first time in to RMAIL +(defun rmail-mode-fun1 () + "add ht's mods to RMAIL" + (define-key rmail-mode-map "R" 'reply-w/o-cc) + (define-key rmail-mode-map "M" 'rmht-output) + (define-key rmail-mode-map "H" 'print-buffer) + (define-key rmail-mode-map "W" 'edit-and-move-to-diary) + (define-key rmail-mode-map "D" 'update-default-diary) + (define-key rmail-mode-map "F" 're-post-failed-mail) + (define-key rmail-mode-map "B" 'ht-write-body-to-file) + ;; fix the doc string + (repl-comment 'rmail-mode + "Rmail Mode is used by \\[rmail] for editing Rmail files. +All normal editing commands are turned off. +Instead, these commands are available (additions from ht's mail-extras.el +indicated by *: + +. Move point to front of this message (same as \\[beginning-of-buffer]). +SPC Scroll to next screen of this message. +DEL Scroll to previous screen of this message. +n Move to Next non-deleted message. +p Move to Previous non-deleted message. +M-n Move to Next message whether deleted or not. +M-p Move to Previous message whether deleted or not. +> Move to the last message in Rmail file. +j Jump to message specified by numeric position in file. +M-s Search for string and show message it is found in. +d Delete this message, move to next nondeleted. +C-d Delete this message, move to previous nondeleted. +u Undelete message. Tries current message, then earlier messages + till a deleted message is found. +e Expunge deleted messages. +s Expunge and save the file. +q Quit Rmail: expunge, save, then switch to another buffer. +C-x C-s Save without expunging. +g Move new mail from system spool directory or mbox into this file. +m Mail a message (same as \\[mail-other-window]). +c Continue composing outgoing message started before. +r Reply to this message. Like m but initializes some fields. +R * Like r, but reply to originator only. +f Forward this message to another user. +F * like f, but assumes message is \"failed mail\" for re-sending +o Output this message to an Rmail file (append it). +C-o Output this message to a Unix-format mail file (append it). +M * Output this message to a file, + in format determined by extension (babyl for RMAIL/msg for Unix). +B * Write the body of the message to a file, leaving a pointer +H * Print the message (same as \\<global-map>\\[print-buffer]).\\<rmail-mode-map> +i Input Rmail file. Run Rmail on that file. +a Add label to message. It will be displayed in the mode line. +k Kill label. Remove a label from current message. +C-M-n Move to Next message with specified label + (label defaults to last one specified). + Standard labels: filed, unseen, answered, forwarded, deleted. + Any other label is present only if you add it with `a'. +C-M-p Move to Previous message with specified label +h, C-M-h Show headers buffer, with a one line summary of each message. +l, C-M-l Like h only just messages with particular label(s) are summarized. +C-M-r Like h only just messages with particular recipient(s) are summarized. +t Toggle header, show Rmail header if unformatted or vice versa. +w Edit the current message. C-c C-c to return to Rmail. +W * Edit the subject field. C-c C-c to move the message to the Diary. +D * Update the Diary. + +Messages for the diary (see also \\[describe-mode] in rmail-summary mode +or \\[describe-function] rmail-summary-mode) should have a subject field +which begins with the date and optional time of the event described therein. +These must be in the form + d m y t +where d is one or two digits for the day, +m is either the full month name or the first three letters thereof, +y is two digits for the year, +and t, if present, is 4 digits for the time, +thus for example + 31 Jun 91 1530 +") + (remove-hook 'rmail-mode-hook 'rmail-mode-fun1)) + +(defun rmail-mode-fun2 () + "always run in RMAIL mode" + (setq case-fold-search t)) + +(defun reply-w/o-cc () + "Reply as r, but without sending to other recipients" + (interactive) + (rmail-reply t)) + +(defun rmht-output (&optional file-name gnus) + "Move to a file, determining format by extension (babyl/msg)" + (interactive) + (if (not file-name) + (setq file-name (car (get-move-file-name)))) + (if (string-match "\\.g?[zZ]$" file-name) + (let ((clean-file-name (substring file-name 0 (match-beginning 0))) + there) + (if (setq there (get-file-buffer clean-file-name)) + nil + (save-window-excursion (rmail clean-file-name) + (setq there + (get-file-buffer clean-file-name)))) + (rmht-output clean-file-name gnus) + (if rmht-always-recompress + (save-excursion + (set-buffer there) + (save-buffer)) + (if (not rmht-allow-autosave) + (save-excursion + (set-buffer there) + (auto-save-mode -1))))) + (setq file-name (expand-file-name file-name)) + (save-excursion + (if (string-match "\\.babyl$" file-name) + (if gnus + (gnus-output-to-rmail file-name) + (rmail-output-to-rmail-file file-name 1)) + (if (string-match "\\.msg$" file-name) + (if (or (get-file-buffer file-name) + (file-exists-p file-name) + (yes-or-no-p + (concat "\"" file-name "\" does not exist, create it? "))) + (rmail-output file-name 1) + (error "Output file does not exist")) + (error "not a valid mail file: %s" file-name)))) + (setq ht-last-file file-name) + (if (not gnus) (ht-rmail-delete-forward)))) + +(defun get-move-file-name () + "get a file name for moving a message to" + (list (read-file-name + (concat "Output message to file: (default " + (file-name-nondirectory ht-last-file) + ") ") + (file-name-directory ht-last-file) + ht-last-file))) + +(defun re-post-failed-mail () + "try to salvage the original from failed mail and prepare to resend it" + (interactive) + (rmail-forward nil) + (let ((top (point)) + subjp textp) + (re-search-forward "^Subject: ") + (kill-line nil) + (setq subjp (point)) + (re-search-forward "^From: ") ; the bouncer + (re-search-forward "^From: ") ; should be us + (re-search-forward "^Subject: ") + (kill-line nil) + (save-excursion (goto-char subjp) + (yank)) + (beginning-of-line 3) + (setq textp (point)) + (goto-char top) + (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) + (beginning-of-line 2) + (delete-region (point) textp) + (goto-char top))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; mods and fixes for mail summaries ;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(add-hook 'rmail-summary-mode-hook 'rmail-summary-mode-fun1) + +;; run the first time we make a summary window +(defun rmail-summary-mode-fun1 () + "install ht's mods" + (define-key rmail-summary-mode-map "r" 'rms-reply-w-cc) + (define-key rmail-summary-mode-map "R" 'rms-reply-w/o-cc) + (define-key rmail-summary-mode-map "s" 'diary-save) + (define-key rmail-summary-mode-map "m" 'rms-move) + (define-key rmail-summary-mode-map "d" 'rms-delete) + (define-key rmail-summary-mode-map "h" 'rms-hardcopy) + (define-key rmail-summary-mode-map " " 'ht-rmailsum-scroll-msg-up) + (define-key rmail-summary-mode-map "\177" 'ht-rmailsum-scroll-msg-down) + ;; fix the doc string + (repl-comment 'rmail-summary-mode + "Major mode in effect in Rmail summary buffer. +A subset of the Rmail mode commands are supported in this mode. +As commands are issued in the summary buffer the corresponding +mail message is displayed in the rmail buffer. +Modifications from ht's mail-extras.el indicated with *: + +n Move to next undeleted message, or arg messages. +p Move to previous undeleted message, or arg messages. +C-n Move to next, or forward arg messages. +C-p Move to previous, or previous arg messages. +j Jump to the message at the cursor location. +d Delete the message at the cursor location and move to next message. +u Undelete this or previous deleted message. +q Quit Rmail. +x Exit and kill the summary window. +space * If cursor is on line of current message, + scroll message window forward. Otherwise, jump to indicated message. +delete * same as space, but scrolls backward. +r * Same as r in rmail window. Reply to current message. +R * Same as R in rmail window. Reply to current message, originator only. +s * Update and save the rmail file, and re-summarise. Re-sorts if Diary. +m * Same as M in rmail window. Moves message to file. +h * Same as H in rmail window. Prints message on line printer. + +Entering this mode calls value of hook variable rmail-summary-mode-hook. + +If the file summarised is called by the name given in ht-diary-file-name, +which defaults to diary.babyl, +then the summary will be called *Diary*, sorted in date order and +formated in a special way. + +Messages in the diary should have a subject field +which begins with the date and optional time of the event described therein. +These must be in the form + d m y t +where d is one or two digits for the day, +m is either the full month name or the first three letters thereof, +y is two digits for the year, +and t, if present, is 4 digits for the time, +thus for example +Subject: 31 Jun 91 1530 Hades freezing ceremony followed by champagne reception +") + (remove-hook 'rmail-summary-mode-hook 'rmail-summary-mode-fun1)) + +(defun rmht-sum-reply (sender-only) + "reply to current message" + (rmail-summary-goto-msg) + (pop-to-buffer rmail-buffer) + (rmail-reply sender-only) + (switch-to-buffer rmail-summary-buffer) + (switch-to-buffer "*mail*") +) + +(defun rms-reply-w-cc () + "Do r in RMAIL - reply to everybody" + (interactive) + (rmht-sum-reply nil)) + +(defun rms-reply-w/o-cc () + "Do R in RMAIL - reply to sender only" + (interactive) + (rmht-sum-reply t)) + +(defun rms-save () + "expunge deleted messages, save RMAIL file and re-display headers" + (interactive) + (pop-to-buffer rmail-buffer) + (rmail-expunge-and-save) + (rmail-summary)) + +(defun rms-delete () + "delete current and move down to next in summary buffer" + (interactive) + (rmail-summary-goto-msg) + (save-excursion + (set-buffer rmail-buffer) + (rmail-delete-forward nil)) + (rms-del)) + +(defun rms-move () + "Move to a file, mode determined by file extension (babyl/msg)" + (interactive) + (rmail-summary-goto-msg) + (save-excursion + (set-buffer rmail-buffer) + (rmht-output)) + (rms-del)) + +(defun rms-del () + "mark current summary line as deleted and move down" + (let ((buffer-read-only nil)) + (skip-chars-forward " ") + (skip-chars-forward "[0-9]") + (delete-char 1) + (insert "D")) + (forward-line 1)) + +(defun rms-hardcopy () + "hardcopy the current message" + (interactive) + (pop-to-buffer rmail-buffer) + (print-buffer) + (pop-to-buffer rmail-summary-buffer)) + + +;; fix interpretation of SPACE and DEL in summary windows to +;; 1) scroll the right window regardless of how many panes are up; +;; 2) go to the message associated with the current line if not already there, +;; a la gnus, for instance + +(defun ht-rmailsum-normalise () + "if not already showing message named on current line, go to it & return t" + (beginning-of-line) + (let ((current-msg-num (cdr (assoc 'rmail-current-message + (buffer-local-variables + (or rmail-buffer + (error + "not in a summary buffer")))))) + (line-message-num (string-to-int + (buffer-substring + (point) + (min (point-max)(+ 5 (point))))))) + (if (= current-msg-num line-message-num) + nil + (rmail-summary-goto-msg line-message-num) + t))) + +(defun ht-rmailsum-scroll-msg-up (&optional dist) + "goto other message or scroll current message forward" + (interactive "P") + (if (ht-rmailsum-normalise) + nil + (pop-to-buffer rmail-buffer) + (scroll-up dist) + (pop-to-buffer rmail-summary-buffer))) + +(defun ht-rmailsum-scroll-msg-down (&optional dist) + "goto other message or scroll current message backward" + (interactive "P") + (if (ht-rmailsum-normalise) + nil + (pop-to-buffer rmail-buffer) + (scroll-down dist) + (pop-to-buffer rmail-summary-buffer))) + +(autoload 'edit-and-move-to-diary "diary") +(autoload 'update-diary "diary") +(autoload 'diary-save "diary") + +;; unfortunately, gnus mucks about with the buffers before calling +;; mail, so we have to intervene to make the about-to-mail-hook work right + +(defun ht-Subject-mode-fun () + "fix the map to save window state" + (define-key gnus-summary-mode-map "r" 'ht-Subject-mail-reply) + (define-key gnus-summary-mode-map "R" 'ht-Subject-mail-reply-with-original) + (define-key gnus-summary-mode-map "m" 'ht-Subject-mail-other-window) + (define-key gnus-summary-mode-map "M" 'ht-Subject-move) + (remove-hook 'gnus-summary-mode-hook 'ht-Subject-mode-fun)) + +(add-hook 'gnus-summary-mode-hook 'ht-Subject-mode-fun) + +(defun ht-Subject-mail-reply (yank) + "Runs about-to-mail-hook, then calls gnus-summary-mail-reply" + (interactive "P") + (require 'sendmail) + (run-hooks 'about-to-mail-hook) + (let (about-to-mail-hook) + (gnus-summary-reply yank))) + +(defun ht-Subject-mail-reply-with-original () + "Runs about-to-mail-hook, then calls gnus-summary-mail-reply-with-original" + (interactive) + (require 'sendmail) + (run-hooks 'about-to-mail-hook) + (let (about-to-mail-hook) + (gnus-summary-reply-with-original))) + +(defun ht-Subject-mail-other-window () + "Runs about-to-mail-hook, then calls gnus-summary-mail-other-window" + (interactive) + (require 'sendmail) + (run-hooks 'about-to-mail-hook) + (let (about-to-mail-hook) + (gnus-summary-mail-other-window))) + +(defun ht-Subject-move () + "Move article to a file, mode determined by file extension (babyl/msg)" + (interactive) + (gnus-summary-select-article) + (save-excursion + (set-buffer gnus-article-buffer) + (rmht-output nil t))) + + +(defun ht-write-body-to-file (file) + "Write the body of the message to a file and replace it with a pointer" + (interactive "FFile to save in: ") + (goto-char (point-min)) + (or (search-forward "\n\n" nil t) + (error "Can't find text")) + (write-region (point)(point-max) file) + (rmail-edit-current-message) + (delete-region (point)(point-max)) + (insert "\n>> " file "\n") + (rmail-cease-edit) + (rmht-output))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/emacs/mdn-extras.el Tue May 25 13:57:42 2021 -0400 @@ -0,0 +1,164 @@ +;; Last edited: Thu Jun 11 14:04:02 1992 +;; stub for henry's mail reading and diary maintenance tools +;; Copyright (C) 1990 Henry S. Thompson +;; Edit history: made diary-setup do (update-default-diary nil) instead of t + +;; This file is part of GNU Emacs. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY. No author or distributor +;; accepts responsibility to anyone for the consequences of using it +;; or for whether it serves any particular purpose or works at all, +;; unless he says so in writing. Refer to the GNU Emacs General Public +;; License for full details. + +;; Everyone is granted permission to copy, modify and redistribute +;; GNU Emacs, but only under the conditions described in the +;; GNU Emacs General Public License. A copy of this license is +;; supposed to have been given to you along with GNU Emacs so you +;; can know your rights and responsibilities. It should be in a +;; file named COPYING. Among other things, the copyright notice +;; and this notice must be preserved on all copies. + +(provide 'mdn-extras) + +;; get my sendmail, on way or another + +(if (featurep 'sendmail) + ;; already loaded - overwrite + (site-caseq + (parc (load "~hthompso/emacs/shared/sendmail")))) + +(setq command-switch-alist + (nconc command-switch-alist '(("-m" . ht-mail-setup) + ("-mail" . ht-mail-setup) + ("-d" . ht-diary-setup) + ("-diary" . ht-diary-setup)))) + +(setq command-switch-alist + (nconc command-switch-alist '(("-n" . ht-news-setup) + ("-news" . ht-news-setup)))) + +(autoload 'gnus "gnus" "read news" t) + +(defvar ht-default-config nil "saved window configuration after startup") +(defvar ht-back-config (current-window-configuration) + "saved window configuration from before ^Cw/^C^w") + +(defun ht-mail-setup (&optional arg) + "set up my mail reading and do it" + (interactive) + (require 'mail-extras) ; mail stuff + (if (featurep 'gnus) ; in case gnus is around + (split-window-vertically)) + (rmail) + (setq ht-default-config (current-window-configuration))) + +(defun ht-diary-setup (&optional arg) + "diary setup" + (interactive) + (require 'diary) + (update-default-diary nil) ; set up standard config. + (if (featurep 'rmail) + (if (featurep 'gnus) ; in case gnus is around + (progn (other-window 1) + (split-window) + (other-window 1) + (switch-to-buffer (get-file-buffer rmail-file-name))) + (switch-to-buffer (get-file-buffer rmail-file-name)) + (other-window 1) + (split-window) + (other-window 1) + (switch-to-buffer (save-excursion (set-buffer (get-file-buffer + ht-diary-file-name)) + rmail-summary-buffer)) + (other-window 1))) + (setq ht-default-config (current-window-configuration))) + +(defun ht-news-setup (&optional arg) + "set up my GNUS and do it" + (interactive) + (require 'my-news) ; GNUS stuff + (if (featurep 'rmail) + (split-window-vertically)) + (gnus) + (setq ht-default-config (current-window-configuration))) + +(defun default-config () + "restore screen to default config" + (interactive) + (setq ht-back-config (current-window-configuration)) + (set-window-configuration ht-default-config)) + +(defun back-config () + (interactive) + (set-window-configuration (prog1 ht-back-config + (setq ht-back-config + (current-window-configuration))))) + +(global-set-key "\C-cw" 'default-config) + +(global-set-key "\C-c\C-w" 'back-config) + +(setq mail-custom-fields + '(("To" (fill-addr-field (local-field-var to "")) "\C-t") + ("Subject" (ht-subj-with-reply) "\C-s"))) + +(defun ht-subj-with-reply () + (let ((subj (local-field-var subject "")) + (irt (local-field-var in-reply-to))) + (if (and in-reply-to + (not (string-match "^Re:" subj))) + (concat "Re: " subj) + subj))) + + +;;; Henry's special double update hack + +(add-hook 'rmail-mode-hook 'rmail-mode-fun3) + +(defun get-mail-news-and () + "update both if both present" + (interactive) + (rmail-get-new-mail) + (let (nw) + (setq nw (get-buffer "*Newsgroup*")) + (if nw + (save-window-excursion + (pop-to-buffer nw) + (gnus-group-get-new-news))))) + +;;; rescued from old rmail +;;; hacked to cope with differences between e19 and lucid +(defun ht-rmail-delete-forward (&optional backward) + "Delete this message and move to next nondeleted one. +Deleted messages stay in the file until the \\[rmail-expunge] command is given. +With prefix argument, delete and move backward. +If there is no nondeleted message to move to +in the preferred or specified direction, move in the other direction." + (interactive "P") + (rmail-set-attribute "deleted" t) + (if (or + (string-match "Lucid" emacs-version) + (and (boundp 'emacs-minor-version) + (> emacs-minor-version 19) ; not sure where pblm was fixed + ; certainly by 28 + )) + (if (not (rmail-next-undeleted-message (if backward -1 1))) + (if (rmail-previous-undeleted-message (if backward -1 1)) + (message "") ; override the stupid one + )) + (if (rmail-next-undeleted-message (if backward -1 1)) + (if (not (rmail-previous-undeleted-message (if backward -1 1))) + (message ""))))) + +(defun rmail-mode-fun4 () + (setq buffer-auto-save-file-name nil) + (make-variable-buffer-local 'backup-inhibited) + (setq backup-inhibited t)) + +(defun rmail-mode-fun3 () + (define-key rmail-mode-map "G" 'get-mail-news-and) + (define-key rmail-mode-map "d" 'ht-rmail-delete-forward) + (remove-hook 'rmail-mode-hook 'rmail-mode-fun3) + (add-hook 'rmail-mode-hook 'rmail-mode-fun4 t))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/emacs/prompt-for-word.el Tue May 25 13:57:42 2021 -0400 @@ -0,0 +1,47 @@ +;; Last edited: Wed Nov 14 14:20:08 1990 +;;; define an interlisp-style prompt-for-word +(provide 'prompt-for-word) + +(defun prompt-for-word (prompt candidate completion-table keymap) + "prompt for a word using PROMPT, and CANDIDATE as first choice. +If any inserting characters are typed, they replace the candidate. +Uses KEYMAP if non-nil, otherwise +if completion-table is non-nil, + uses minibuffer-local-must-match-map plus ^N to exit as is, + thereby allowing New answers, +otherwise uses minibuffer-local-map." + (let ((current-window (selected-window)) + (echo-keystrokes 0) + char) + (select-window (minibuffer-window)) + (erase-buffer) + (insert prompt candidate) + (setq char (read-char)) + (let ((str (make-string 1 char))) + (if (eq (or (local-key-binding str) + (global-key-binding str)) + 'self-insert-command) + (setq candidate nil))) + (select-window current-window) + (if (boundp 'unread-command-event) + ;; lemacs + (setq unread-command-event + (character-to-event char)) + (setq unread-command-char char)) + (let ((minibuffer-completion-table completion-table) + (minibuffer-completion-confirm nil)) + ;; not quite the same as completing-read, because you can't + ;; get m-c-c nil and m-m-map simultaneously + (read-from-minibuffer prompt candidate + (or keymap + (if completion-table + ;; allow ^N to exit with non-match for + ;; new names + pfw-map + minibuffer-local-map)))))) + +(defvar pfw-map (let ((new (copy-keymap minibuffer-local-must-match-map))) + (define-key new "\C-n" 'exit-minibuffer) + new) + "special completion map for prompt-for-word (q.v.)") +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/emacs/repl-comment.el Tue May 25 13:57:42 2021 -0400 @@ -0,0 +1,51 @@ +;; Universal (?) replace comment in function + +;; Last edited: Thu Oct 7 09:39:50 1993 +(defun repl-comment (fn comment) + "replace/install as FN's comment COMMENT, no matter what emacs/compiler" + (let ((defn (symbol-function fn))) + (if (consp defn) + (if (eq (car defn) 'autoload) + (progn (load-library (car (cdr defn))) + (if (equal defn (symbol-function fn)) + (error "autoloading didn't help define %s" fn) + (repl-comment fn comment))) + ;; either symbolic or old byte-compiler + (if (eq (car defn) 'lambda) + (if (stringp (car (cdr (cdr defn)))) + (rplaca (cdr (cdr defn)) + comment) + (rplacd (cdr defn) + (cons comment + (cdr (cdr defn))))) + (error "can't diagnose defn %s" defn))) + ;; array or not + (if (compiled-function-p defn) + (fset fn (repl-byte fn (list (cons 4 comment)))) + (error "unrecognised defn %s" defn))))) + +(defun repl-byte (fn alist) + "compute a new byte-code defn for FN, replacing +elements using ALIST, which is interpreted as (index . newbit). +Elements are 0: arglist 1: byte-codes 2: symbols 3: stack-depth 4: comment" + (let + ((defn (symbol-function fn))) + (let ((ln (if (sequencep defn) + (length defn) + ;; hack otherwise + 6)) + (i 0) + new entry) + (apply (function make-byte-code) + (progn (while (< i ln) + (setq new + (cons + (if (setq entry (assoc i alist)) + (cdr entry) + (aref defn i)) + new)) + (setq i (1+ i))) + (nreverse new)))))) + + +(provide 'repl-comment)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/emacs/xml-hack.el Tue May 25 13:57:42 2021 -0400 @@ -0,0 +1,8 @@ +(defun sgml-tag-again () + "Insert another of the tag we're in as sibling" + (interactive ) + (let ((elt (sgml-find-element-of (point)))) + (sgml-up-element) + (sgml-insert-element elt))) + +(define-key sgml-mode-map "\C-cn" 'sgml-tag-again)