Mercurial > hg > xemacs-beta

comparison lisp/tm/tm-edit-tipgp.el @ 76:c0c698873ce1 r20-0b33

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b33
author cvs
date Mon, 13 Aug 2007 09:05:10 +0200
parents
children
comparison
equal deleted inserted replaced
75:a4e0195b387b 76:c0c698873ce1
1 ;;; tm-edit-tipgp.el -- TinyPgp.el PGP interface
2
3 ;; Copyright (C) 1996 Jari aalto
4
5 ;; Author: Jari Aalto <jari.aalto@poboxes.com>
6 ;; Version: $Id: tm-edit-tipgp.el,v 1.1 1996/12/28 21:12:31 steve Exp $
7 ;; Keywords: mail, news, MIME, multimedia, multilingual, security, PGP
8
9 ;; This file is part of tm (Tools for MIME).
10
11 ;; This program is free software; you can redistribute it and/or
12 ;; modify it under the terms of the GNU General Public License as
13 ;; published by the Free Software Foundation; either version 2, or (at
14 ;; your option) any later version.
15
16 ;; This program is distributed in the hope that it will be useful, but
17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
19 ;; General Public License for more details.
20
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24 ;; Boston, MA 02111-1307, USA.
25
26 ;;; Code:
27
28 (require 'tinypgpa.el)
29
30 (defun tm:tipgp-process-region (result-buffer boundary)
31 (let ((obuf (current-buffer))
32 )
33 (cond
34 (boundary
35 (goto-char (point-min))
36 (insert (format "--%s\n" boundary))
37 (goto-char (point-max))
38 (insert (format "\n--%s
39 Content-Type: application/pgp-signature
40 Content-Transfer-Encoding: 7bit
41
42 " boundary))
43 (insert-buffer-substring result-buffer)
44 (goto-char (point-max))
45 (insert (format "\n--%s--\n" boundary))
46 )
47 (t
48 (delete-region beg end)
49 (goto-char beg)
50 (insert-buffer-substring result-buffer)
51 ))
52 ))
53
54
55
56
57 (defun tm:tipgp-sign-region (start end &optional id unclear boundary)
58 ;; start end = Region
59 ;; id =
60 ;; unclear =
61 ;; boundary = pgp-sign-Multipart_Wed_Dec__4_11:14:41_1996-1
62
63 (let (tipgp-:xpgp-header-mode ;Do not use X-Pgp signing
64 passwd
65 ret
66 )
67
68 (setq passwd (tipgp-password-get-old "Sign pass phrase: "))
69
70
71 ;; The region is already narrowed by TM, so we pass the
72 ;; point-min point-max
73 ;;
74 ;; The macro tipgp-run-in-tmp-buffer cpies the contents to
75 ;; another buffer and when signing is over, it will
76 ;; contain fully signed message
77 ;;
78 (setq
79 ret
80 (tipgp-run-in-tmp-buffer nil
81 (tipgp-sign-region
82 (point-min) (point-max) passwd 'verb
83 (format
84 "+comment=\"Processed by TinyPgp.el %s\""
85 (strmatget "[0-9][0-9.]+" 0 tipgp-version-id)
86 )
87 'noerr
88 )))
89
90 (if ret
91 (tm:tipgp-process-region tipgp-:buffer-tmp-copy boundary))
92
93 (cond
94 ((and boundary ret)
95 (goto-char (point-min))
96 (insert
97 (format "\
98 --[[multipart/signed; protocol=\"application/pgp-signature\";
99 boundary=\"%s\"; micalg=pgp-md5][7bit]]\n" boundary))
100 ))
101 ret
102 ))
103
104
105
106 (defun tm:tipgp-pgp-encrypt-region (recipients start end &optional id sign)
107 (let (;; do not use these hooks while in TM
108
109 tipgp-cmd-macro-before-hook
110 tipgp-cmd-macro-after-hook
111
112 ;; TinyPgp.el: has separate encrypt and signing functions.
113 ;;
114 ;;; (mc-pgp-always-sign
115 ;;; (if (eq sign 'maybe)
116 ;;; mc-pgp-always-sign
117 ;;; 'never))
118
119 (elist (ti::mt-email-from-string recipients))
120 )
121 (if (null elist)
122 (error "TO,CC,BCC fields don't contain email addresses."))
123 (tipgp-encrypt-region (point-min) (point-max) elist nil 'verb)
124 ))
125
126
127 ;;; @ end
128 ;;;
129
130 (provide 'tm-edit-tipgp)
131
132 ;;; tm-edit-tipgp.el ends here