view mdn-extras.el @ 61:963ac2f8e386

old local
author Henry S. Thompson <ht@inf.ed.ac.uk>
date Fri, 05 Apr 2024 10:13:30 +0100
parents 06827fc8ae79
children
line wrap: on
line source

;; 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))