1 ;;; canlock-om.el --- Mule 2 specific functions for canlock
2 ;; Copyright (C) 2001 Katsumi Yamaoka
4 ;; Author: Katsumi Yamaoka <yamaoka@jpl.org>
5 ;; Keywords: mule, cancel-lock
7 ;; This program is free software; you can redistribute it and/or modify
8 ;; it under the terms of the GNU General Public License as published by
9 ;; the Free Software Foundation; either version 2, or (at your option)
12 ;; This program is distributed in the hope that it will be useful,
13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 ;; GNU General Public License for more details.
17 ;; You should have received a copy of the GNU General Public License
18 ;; along with this program; see the file COPYING. If not, write to the
19 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 ;; Boston, MA 02111-1307, USA.
24 ;; This program is used to make canlock.el work with Mule 2.3 based on
25 ;; Emacs 19.34. See README.ja in the canlock distribution for details.
30 (cond ((and (boundp 'emacs-major-version)
31 (> emacs-major-version 19))
33 Error: You should never use canlock-om.el(c) for this environment"))
35 (boundp 'emacs-major-version)
36 (= emacs-major-version 19)
37 (>= emacs-minor-version 29)))
39 (error "Error: Canlock does not support this version of Emacs"))))
46 (unless (fboundp 'custom-declare-variable)
47 (error "Error: Canlock requires new custom")))
50 (unless (fboundp 'byte-compile-file-form-custom-declare-variable)
51 (defun byte-compile-file-form-custom-declare-variable (form)
52 ;; Bind defcustom'ed variables.
53 (if (memq 'free-vars byte-compile-warnings)
54 (setq byte-compile-bound-variables
55 (cons (nth 1 (nth 1 form)) byte-compile-bound-variables)))
56 (if (memq ':version (nthcdr 4 form))
57 ;; Make the variable uncustomizable.
58 `(defvar ,(nth 1 (nth 1 form)) ,(nth 1 (nth 2 form))
59 ,(substring (nth 3 form)
60 (if (string-match "^[\t *]+" (nth 3 form))
63 ;; Ignore unsupported keyword(s).
64 (if (memq ':set-after (nthcdr 4 form))
65 (let ((newform (list (car form) (nth 1 form)
66 (nth 2 form) (nth 3 form)))
67 (args (nthcdr 4 form)))
69 (or (eq (car args) ':set-after)
70 (setq newform (nconc newform (list (car args)
72 (setq args (cdr (cdr args))))
75 (put 'custom-declare-variable 'byte-hunk-handler
76 'byte-compile-file-form-custom-declare-variable))
78 (define-compiler-macro with-temp-buffer (&whole form &rest forms)
79 (let ((def (if (fboundp 'with-temp-buffer)
80 (symbol-function 'with-temp-buffer))))
83 (or (eq (car def) 'macro)
84 (and (eq (car def) 'autoload)
85 (memq (nth 4 def) '(macro t)))))
87 ;; The function definition is imported from APEL.
88 `(let ((obuffer (current-buffer))
89 (buffer (generate-new-buffer " *temp*")))
94 (if (buffer-name buffer)
96 (if (buffer-live-p obuffer)
97 (set-buffer obuffer))))))))
99 (autoload 'base64-encode "base64")
101 (defcustom canlock-base64-encode-function 'base64-encode-string
102 "Function to call to base64 encode a string."
103 :type '(radio (function-item base64-encode-string)
104 (function-item base64-encode)
105 (function-item canlock-base64-encode-string-with-mmencode)
106 (function :tag "Other"))
109 (defcustom canlock-mmencode-program "mmencode"
110 "Name of mmencode program."
114 (defcustom canlock-mmencode-args-for-encoding nil
115 "Arguments passed to mmencode program for encoding."
119 (defun canlock-base64-encode-string-with-mmencode (string)
120 "Base64 encode a string using mmencode."
124 (let ((default-process-coding-system (cons *iso-2022-jp*dos *noconv*))
125 program-coding-system-alist selective-display)
126 (apply 'call-process-region (point-min) (point-max)
127 canlock-mmencode-program t t nil
128 canlock-mmencode-args-for-encoding))
129 (goto-char (point-max))
130 (skip-chars-backward "\n")
131 (buffer-substring (point-min) (point))))
133 ;; The following macros will only be used to byte-compile canlock.el.
135 (define-compiler-macro base64-encode-string
136 (&whole form string &optional no-line-break)
137 (if (and (string-equal (buffer-name) " *Compiler Input*")
138 (string-equal ";;; canlock.el"
139 (buffer-substring (point-min)
140 (min (+ (point-min) 14)
143 `(let ((string ,string))
146 (insert (funcall canlock-base64-encode-function string))
147 (goto-char (point-min))
148 (while (search-forward "\n" nil t)
151 (funcall canlock-base64-encode-function string)))
152 `(funcall canlock-base64-encode-function ,string))
155 (define-compiler-macro split-string (&whole form string &optional pattern)
156 (if (and (string-equal (buffer-name) " *Compiler Input*")
157 (string-equal ";;; canlock.el"
158 (buffer-substring (point-min)
159 (min (+ (point-min) 14)
161 ;; The function definition is imported from APEL.
163 `(let ((string ,string)
167 (while (string-match pattern string start)
168 (setq parts (cons (substring string
169 start (match-beginning 0))
171 start (match-end 0)))
172 (nreverse (cons (substring string start) parts)))
173 `(let ((string ,string)
176 (while (string-match "[ \f\t\n\r\v]+" string start)
177 (setq parts (cons (substring string
178 start (match-beginning 0))
180 start (match-end 0)))
181 (nreverse (cons (substring string start) parts))))
184 ;; The following variables might not be bound if the old version of
185 ;; canlock.el(c) exists.
187 (defvar canlock-openssl-args)
188 (defvar canlock-openssl-program))
190 (defun canlock-om-sha1-with-openssl (message)
191 "Make a SHA-1 digest of MESSAGE using OpenSSL."
195 (let ((default-process-coding-system (cons *iso-2022-jp*dos *noconv*))
196 program-coding-system-alist selective-display)
197 (apply 'call-process-region (point-min) (point-max)
198 canlock-openssl-program t t nil canlock-openssl-args))
199 (goto-char (point-min))
201 (while (re-search-forward "\\([0-9A-Fa-f][0-9A-Fa-f]\\)" nil t)
202 (replace-match "\\\\x\\1"))
204 (goto-char (point-min))
205 (read (current-buffer))))
207 ;; Override the original function.
208 (eval-after-load "canlock"
209 '(defalias 'canlock-sha1-with-openssl 'canlock-om-sha1-with-openssl))
211 (provide 'canlock-om)
215 ;;; canlock-om.el ends here