Mercurial > hg > xemacs

comparison mdn-extras.el @ 78:0abfe9bf83a0

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
merge
author Henry S. Thompson <ht@inf.ed.ac.uk>
date Thu, 25 Sep 2025 17:57:05 +0100
parents 06827fc8ae79
children
comparison
equal deleted inserted replaced
77:62fb1a21629a 78:0abfe9bf83a0
1 ;; Last edited: Thu Jun 11 14:04:02 1992
2 ;; stub for henry's mail reading and diary maintenance tools
3 ;; Copyright (C) 1990 Henry S. Thompson
4 ;; Edit history: made diary-setup do (update-default-diary nil) instead of t
5
6 ;; This file is part of GNU Emacs.
7
8 ;; GNU Emacs is distributed in the hope that it will be useful,
9 ;; but WITHOUT ANY WARRANTY. No author or distributor
10 ;; accepts responsibility to anyone for the consequences of using it
11 ;; or for whether it serves any particular purpose or works at all,
12 ;; unless he says so in writing. Refer to the GNU Emacs General Public
13 ;; License for full details.
14
15 ;; Everyone is granted permission to copy, modify and redistribute
16 ;; GNU Emacs, but only under the conditions described in the
17 ;; GNU Emacs General Public License. A copy of this license is
18 ;; supposed to have been given to you along with GNU Emacs so you
19 ;; can know your rights and responsibilities. It should be in a
20 ;; file named COPYING. Among other things, the copyright notice
21 ;; and this notice must be preserved on all copies.
22
23 (provide 'mdn-extras)
24
25 ;; get my sendmail, on way or another
26
27 (if (featurep 'sendmail)
28 ;; already loaded - overwrite
29 (site-caseq
30 (parc (load "~hthompso/emacs/shared/sendmail"))))
31
32 (setq command-switch-alist
33 (nconc command-switch-alist '(("-m" . ht-mail-setup)
34 ("-mail" . ht-mail-setup)
35 ("-d" . ht-diary-setup)
36 ("-diary" . ht-diary-setup))))
37
38 (setq command-switch-alist
39 (nconc command-switch-alist '(("-n" . ht-news-setup)
40 ("-news" . ht-news-setup))))
41
42 (autoload 'gnus "gnus" "read news" t)
43
44 (defvar ht-default-config nil "saved window configuration after startup")
45 (defvar ht-back-config (current-window-configuration)
46 "saved window configuration from before ^Cw/^C^w")
47
48 (defun ht-mail-setup (&optional arg)
49 "set up my mail reading and do it"
50 (interactive)
51 (require 'mail-extras) ; mail stuff
52 (if (featurep 'gnus) ; in case gnus is around
53 (split-window-vertically))
54 (rmail)
55 (setq ht-default-config (current-window-configuration)))
56
57 (defun ht-diary-setup (&optional arg)
58 "diary setup"
59 (interactive)
60 (require 'diary)
61 (update-default-diary nil) ; set up standard config.
62 (if (featurep 'rmail)
63 (if (featurep 'gnus) ; in case gnus is around
64 (progn (other-window 1)
65 (split-window)
66 (other-window 1)
67 (switch-to-buffer (get-file-buffer rmail-file-name)))
68 (switch-to-buffer (get-file-buffer rmail-file-name))
69 (other-window 1)
70 (split-window)
71 (other-window 1)
72 (switch-to-buffer (save-excursion (set-buffer (get-file-buffer
73 ht-diary-file-name))
74 rmail-summary-buffer))
75 (other-window 1)))
76 (setq ht-default-config (current-window-configuration)))
77
78 (defun ht-news-setup (&optional arg)
79 "set up my GNUS and do it"
80 (interactive)
81 (require 'my-news) ; GNUS stuff
82 (if (featurep 'rmail)
83 (split-window-vertically))
84 (gnus)
85 (setq ht-default-config (current-window-configuration)))
86
87 (defun default-config ()
88 "restore screen to default config"
89 (interactive)
90 (setq ht-back-config (current-window-configuration))
91 (set-window-configuration ht-default-config))
92
93 (defun back-config ()
94 (interactive)
95 (set-window-configuration (prog1 ht-back-config
96 (setq ht-back-config
97 (current-window-configuration)))))
98
99 (global-set-key "\C-cw" 'default-config)
100
101 (global-set-key "\C-c\C-w" 'back-config)
102
103 (setq mail-custom-fields
104 '(("To" (fill-addr-field (local-field-var to "")) "\C-t")
105 ("Subject" (ht-subj-with-reply) "\C-s")))
106
107 (defun ht-subj-with-reply ()
108 (let ((subj (local-field-var subject ""))
109 (irt (local-field-var in-reply-to)))
110 (if (and in-reply-to
111 (not (string-match "^Re:" subj)))
112 (concat "Re: " subj)
113 subj)))
114
115
116 ;;; Henry's special double update hack
117
118 (add-hook 'rmail-mode-hook 'rmail-mode-fun3)
119
120 (defun get-mail-news-and ()
121 "update both if both present"
122 (interactive)
123 (rmail-get-new-mail)
124 (let (nw)
125 (setq nw (get-buffer "*Newsgroup*"))
126 (if nw
127 (save-window-excursion
128 (pop-to-buffer nw)
129 (gnus-group-get-new-news)))))
130
131 ;;; rescued from old rmail
132 ;;; hacked to cope with differences between e19 and lucid
133 (defun ht-rmail-delete-forward (&optional backward)
134 "Delete this message and move to next nondeleted one.
135 Deleted messages stay in the file until the \\[rmail-expunge] command is given.
136 With prefix argument, delete and move backward.
137 If there is no nondeleted message to move to
138 in the preferred or specified direction, move in the other direction."
139 (interactive "P")
140 (rmail-set-attribute "deleted" t)
141 (if (or
142 (string-match "Lucid" emacs-version)
143 (and (boundp 'emacs-minor-version)
144 (> emacs-minor-version 19) ; not sure where pblm was fixed
145 ; certainly by 28
146 ))
147 (if (not (rmail-next-undeleted-message (if backward -1 1)))
148 (if (rmail-previous-undeleted-message (if backward -1 1))
149 (message "") ; override the stupid one
150 ))
151 (if (rmail-next-undeleted-message (if backward -1 1))
152 (if (not (rmail-previous-undeleted-message (if backward -1 1)))
153 (message "")))))
154
155 (defun rmail-mode-fun4 ()
156 (setq buffer-auto-save-file-name nil)
157 (make-variable-buffer-local 'backup-inhibited)
158 (setq backup-inhibited t))
159
160 (defun rmail-mode-fun3 ()
161 (define-key rmail-mode-map "G" 'get-mail-news-and)
162 (define-key rmail-mode-map "d" 'ht-rmail-delete-forward)
163 (remove-hook 'rmail-mode-hook 'rmail-mode-fun3)
164 (add-hook 'rmail-mode-hook 'rmail-mode-fun4 t))