--- /dev/null
+;;; canlock-om.el --- Mule 2 specific functions for canlock
+;; Copyright (C) 2001 Katsumi Yamaoka
+
+;; Author: Katsumi Yamaoka <yamaoka@jpl.org>
+;; Keywords: mule, cancel-lock
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This program is used to make canlock.el work with Mule 2.3 based on
+;; Emacs 19.34. See README.ja in the canlock distribution for details.
+
+;;; Code:
+
+(eval-and-compile
+ (cond ((and (boundp 'emacs-major-version)
+ (> emacs-major-version 19))
+ (error "\
+Error: You should never use canlock-om.el(c) for this environment"))
+ ((and (boundp 'MULE)
+ (boundp 'emacs-major-version)
+ (= emacs-major-version 19)
+ (>= emacs-minor-version 29)))
+ (t
+ (error "Error: Canlock does not support this version of Emacs"))))
+
+(eval-when-compile
+ (require 'cl))
+
+(require 'custom)
+(eval-and-compile
+ (unless (fboundp 'custom-declare-variable)
+ (error "Error: Canlock requires new custom")))
+
+(eval-when-compile
+ (unless (fboundp 'byte-compile-file-form-custom-declare-variable)
+ (defun byte-compile-file-form-custom-declare-variable (form)
+ ;; Bind defcustom'ed variables.
+ (if (memq 'free-vars byte-compile-warnings)
+ (setq byte-compile-bound-variables
+ (cons (nth 1 (nth 1 form)) byte-compile-bound-variables)))
+ (if (memq ':version (nthcdr 4 form))
+ ;; Make the variable uncustomizable.
+ `(defvar ,(nth 1 (nth 1 form)) ,(nth 1 (nth 2 form))
+ ,(substring (nth 3 form)
+ (if (string-match "^[\t *]+" (nth 3 form))
+ (match-end 0)
+ 0)))
+ ;; Ignore unsupported keyword(s).
+ (if (memq ':set-after (nthcdr 4 form))
+ (let ((newform (list (car form) (nth 1 form)
+ (nth 2 form) (nth 3 form)))
+ (args (nthcdr 4 form)))
+ (while args
+ (or (eq (car args) ':set-after)
+ (setq newform (nconc newform (list (car args)
+ (car (cdr args))))))
+ (setq args (cdr (cdr args))))
+ newform)
+ form)))
+ (put 'custom-declare-variable 'byte-hunk-handler
+ 'byte-compile-file-form-custom-declare-variable))
+
+ (define-compiler-macro with-temp-buffer (&whole form &rest forms)
+ (let ((def (if (fboundp 'with-temp-buffer)
+ (symbol-function 'with-temp-buffer))))
+ (if (and def
+ (consp def)
+ (or (eq (car def) 'macro)
+ (and (eq (car def) 'autoload)
+ (memq (nth 4 def) '(macro t)))))
+ form
+ ;; The function definition is imported from APEL.
+ `(let ((obuffer (current-buffer))
+ (buffer (generate-new-buffer " *temp*")))
+ (unwind-protect
+ (progn
+ (set-buffer buffer)
+ ,@forms)
+ (if (buffer-name buffer)
+ (kill-buffer buffer))
+ (if (buffer-live-p obuffer)
+ (set-buffer obuffer))))))))
+
+(autoload 'base64-encode "base64")
+
+(defcustom canlock-base64-encode-function 'base64-encode-string
+ "Function to call to base64 encode a string."
+ :type '(radio (function-item base64-encode-string)
+ (function-item base64-encode)
+ (function-item canlock-base64-encode-string-with-mmencode)
+ (function :tag "Other"))
+ :group 'canlock)
+
+(defcustom canlock-mmencode-program "mmencode"
+ "Name of mmencode program."
+ :type 'string
+ :group 'canlock)
+
+(defcustom canlock-mmencode-args-for-encoding nil
+ "Arguments passed to mmencode program for encoding."
+ :type 'sexp
+ :group 'canlock)
+
+(defun canlock-base64-encode-string-with-mmencode (string)
+ "Base64 encode a string using mmencode."
+ (with-temp-buffer
+ (setq mc-flag nil)
+ (insert string)
+ (let ((default-process-coding-system (cons *iso-2022-jp*dos *noconv*))
+ program-coding-system-alist selective-display)
+ (apply 'call-process-region (point-min) (point-max)
+ canlock-mmencode-program t t nil
+ canlock-mmencode-args-for-encoding))
+ (goto-char (point-max))
+ (skip-chars-backward "\n")
+ (buffer-substring (point-min) (point))))
+
+;; The following macros will only be used to byte-compile canlock.el.
+(eval-when-compile
+ (define-compiler-macro base64-encode-string
+ (&whole form string &optional no-line-break)
+ (if (and (string-equal (buffer-name) " *Compiler Input*")
+ (string-equal ";;; canlock.el"
+ (buffer-substring (point-min)
+ (min (+ (point-min) 14)
+ (point-max)))))
+ (if no-line-break
+ `(let ((string ,string))
+ (if ,no-line-break
+ (with-temp-buffer
+ (insert (funcall canlock-base64-encode-function string))
+ (goto-char (point-min))
+ (while (search-forward "\n" nil t)
+ (delete-char -1))
+ (buffer-string))
+ (funcall canlock-base64-encode-function string)))
+ `(funcall canlock-base64-encode-function ,string))
+ form))
+
+ (define-compiler-macro split-string (&whole form string &optional pattern)
+ (if (and (string-equal (buffer-name) " *Compiler Input*")
+ (string-equal ";;; canlock.el"
+ (buffer-substring (point-min)
+ (min (+ (point-min) 14)
+ (point-max)))))
+ ;; The function definition is imported from APEL.
+ (if pattern
+ `(let ((string ,string)
+ (pattern ,pattern)
+ (start 0)
+ parts)
+ (while (string-match pattern string start)
+ (setq parts (cons (substring string
+ start (match-beginning 0))
+ parts)
+ start (match-end 0)))
+ (nreverse (cons (substring string start) parts)))
+ `(let ((string ,string)
+ (start 0)
+ parts)
+ (while (string-match "[ \f\t\n\r\v]+" string start)
+ (setq parts (cons (substring string
+ start (match-beginning 0))
+ parts)
+ start (match-end 0)))
+ (nreverse (cons (substring string start) parts))))
+ form)))
+
+;; The following variables might not be bound if the old version of
+;; canlock.el(c) exists.
+(eval-when-compile
+ (defvar canlock-openssl-args)
+ (defvar canlock-openssl-program))
+
+(defun canlock-om-sha1-with-openssl (message)
+ "Make a SHA-1 digest of MESSAGE using OpenSSL."
+ (with-temp-buffer
+ (setq mc-flag nil)
+ (insert message)
+ (let ((default-process-coding-system (cons *iso-2022-jp*dos *noconv*))
+ program-coding-system-alist selective-display)
+ (apply 'call-process-region (point-min) (point-max)
+ canlock-openssl-program t t nil canlock-openssl-args))
+ (goto-char (point-min))
+ (insert "\"")
+ (while (re-search-forward "\\([0-9A-Fa-f][0-9A-Fa-f]\\)" nil t)
+ (replace-match "\\\\x\\1"))
+ (insert "\"")
+ (goto-char (point-min))
+ (read (current-buffer))))
+
+;; Override the original function.
+(eval-after-load "canlock"
+ '(defalias 'canlock-sha1-with-openssl 'canlock-om-sha1-with-openssl))
+
+(provide 'canlock-om)
+
+(require 'canlock)
+
+;;; canlock-om.el ends here
projects / elisp / gnus.git- / commitdiff