Mercurial > hg > xemacs

comparison shared/mdn-extras.el @ 0:107d592c5f4a

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
DICE versions, used by pers/common, recursive, I think/hope
author Henry S. Thompson <ht@inf.ed.ac.uk>
date Mon, 08 Feb 2021 11:44:37 +0000
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:107d592c5f4a
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 (unless (gnuserv-running-p)
87 (gnuserv-start))
88 )
89
90 (defun default-config ()
91 "restore screen to default config"
92 (interactive)
93 (setq ht-back-config (current-window-configuration))
94 (set-window-configuration ht-default-config))
95
96 (defun back-config ()
97 (interactive)
98 (set-window-configuration (prog1 ht-back-config
99 (setq ht-back-config
100 (current-window-configuration)))))
101
102 (global-set-key "\C-cw" 'default-config)
103
104 (global-set-key "\C-c\C-w" 'back-config)
105
106 (setq mail-custom-fields
107 '(("To" (fill-addr-field (local-field-var to "")) "\C-t")
108 ("Subject" (ht-subj-with-reply) "\C-s")))
109
110 (defun ht-subj-with-reply ()
111 (let ((subj (local-field-var subject ""))
112 (irt (local-field-var in-reply-to)))
113 (if (and in-reply-to
114 (not (string-match "^Re:" subj)))
115 (concat "Re: " subj)
116 subj)))
117
118
119 ;;; Henry's special double update hack
120
121 (add-hook 'rmail-mode-hook 'rmail-mode-fun3)
122
123 (defun get-mail-news-and ()
124 "update both if both present"
125 (interactive)
126 (rmail-get-new-mail)
127 (let (nw)
128 (setq nw (get-buffer "*Newsgroup*"))
129 (if nw
130 (save-window-excursion
131 (pop-to-buffer nw)
132 (gnus-group-get-new-news)))))
133
134 ;;; rescued from old rmail
135 ;;; hacked to cope with differences between e19 and lucid
136 (defun ht-rmail-delete-forward (&optional backward)
137 "Delete this message and move to next nondeleted one.
138 Deleted messages stay in the file until the \\[rmail-expunge] command is given.
139 With prefix argument, delete and move backward.
140 If there is no nondeleted message to move to
141 in the preferred or specified direction, move in the other direction."
142 (interactive "P")
143 (rmail-set-attribute "deleted" t)
144 (if (or
145 (string-match "Lucid" emacs-version)
146 (and (boundp 'emacs-minor-version)
147 (> emacs-minor-version 19) ; not sure where pblm was fixed
148 ; certainly by 28
149 ))
150 (if (not (rmail-next-undeleted-message (if backward -1 1)))
151 (if (rmail-previous-undeleted-message (if backward -1 1))
152 (message "") ; override the stupid one
153 ))
154 (if (rmail-next-undeleted-message (if backward -1 1))
155 (if (not (rmail-previous-undeleted-message (if backward -1 1)))
156 (message "")))))
157
158 (defun rmail-mode-fun4 ()
159 (setq buffer-auto-save-file-name nil)
160 (make-variable-buffer-local 'backup-inhibited)
161 (setq backup-inhibited t))
162
163 (defun rmail-mode-fun3 ()
164 (define-key rmail-mode-map "G" 'get-mail-news-and)
165 (define-key rmail-mode-map "d" 'ht-rmail-delete-forward)
166 (remove-hook 'rmail-mode-hook 'rmail-mode-fun3)
167 (add-hook 'rmail-mode-hook 'rmail-mode-fun4 t))