(require 'epg)

(defcustom epg-file-name-regexp "\\.gpg\\'"
  "Regexp that matches filenames that are assumed to be encrypted
with GnuPG."
  :type 'regexp
  :group 'epg-file)

(defun epg-file-handler (operation &rest args)
  (let ((epg-file-operation (get operation 'epg-file)))
    (if epg-file-operation
        (apply epg-file-operation args)
      (epg-file-run-real-handler operation args))))

(defun epg-file-run-real-handler (operation args)
  (let ((inhibit-file-name-handlers
	 (cons 'epg-file-handler
	       (and (eq inhibit-file-name-operation operation)
		    inhibit-file-name-handlers)))
	(inhibit-file-name-operation operation))
    (apply operation args)))

(defvar buffer-file-type)
(defvar last-coding-system-used)
(defun epg-file-write-region (start end filename &optional append visit
				    lockname mustbenew)
  (let* ((visit-file (if (stringp visit)
                         (expand-file-name visit)
                       (expand-file-name filename)))
         ;; XXX: Obtain the value returned by choose_write_coding_system
         (coding-system (condition-case nil
			    (epg-file-run-real-handler
			     'write-region (list start end "/"))
                          (file-error (if (boundp 'last-coding-system-used)
					  last-coding-system-used))))
         ;; start and end are normally buffer positions
         ;; specifying the part of the buffer to write.
         ;; If start is nil, that means to use the entire buffer contents.
         ;; If start is a string, then output that string to the file
         ;; instead of any buffer contents; end is ignored.
         (string (encode-coding-string (cond
                                        ((stringp start)
                                         start)
                                        ((null start)
                                         (buffer-string))
                                        (t
                                         (buffer-substring start end)))
                                       coding-system)))
    (with-temp-buffer
      (if (fboundp 'set-buffer-multibyte)
	  (set-buffer-multibyte nil))
      ;; Optional fourth argument append if non-nil means
      ;;   append to existing file contents (if any).  If it is an integer,
      ;;   seek to that offset in the file before writing.
      (if (and append (file-exists-p filename))
          ;; Enable passphrase cache on this temp buffer
          (let ((coding-system-for-read 'binary))
            ;; set visit to t so that passphrase is cached
            (insert-file-contents filename t)
            (setq buffer-file-name nil)))
      ;; Insert data to encrypt
      (goto-char (if (integerp append) (1+ append) (point-max)))
      (delete-region (point) (min (+ (point) (length string)) (point-max)))
      (insert string)

      (let ((coding-system-for-write 'binary)
            (coding-system-for-read 'binary)
	    (context (epg-make-context))
	    cipher)
	(when (setq cipher (epg-encrypt-string context (buffer-string) nil))
	  (if (and (memq system-type '(ms-dos windows-nt))
		   (boundp 'buffer-file-type))
	      (setq buffer-file-type t))
	  (epg-file-run-real-handler
	   'write-region
	   (list cipher nil filename nil 'not-visit lockname mustbenew)))))
    ;; Optional fifth argument visit, if t or a string, means
    ;;   set the last-save-file-modtime of buffer to this file's modtime
    ;;   and mark buffer not modified.
    ;; If visit is a string, it is a second file name;
    ;;   the output goes to filename, but the buffer is marked as visiting visit.
    ;;   visit is also the file name to lock and unlock for clash detection.
    ;; If visit is neither t nor nil nor a string,
    ;;   that means do not display the "Wrote file" message.
    (when (or (eq visit t) (stringp visit))
      (setq buffer-file-name filename)
      (set-visited-file-modtime))
    (when (stringp visit)
      (setq buffer-file-name visit))
    (when (or (eq visit t) (eq visit nil) (stringp visit))
      (message "Wrote %s" visit-file))
    (if (boundp 'last-coding-system-used)
	(setq last-coding-system-used coding-system))
    nil))

(defun epg-file-insert-file-contents (filename &optional visit beg end replace)
  (barf-if-buffer-read-only)
  (setq filename (expand-file-name filename))
  (let ((filename (expand-file-name filename))
	(length 0))
    (if (file-exists-p filename)
	(let ((local-file
	       (let ((inhibit-file-name-operation
		      (when (eq inhibit-file-name-operation
				'insert-file-contents)
			'file-local-copy)))
		 (file-local-copy filename)))
	      (coding-system-for-read 'binary)
	      (context (epg-make-context))
	      string)
	  (unwind-protect
	      (progn
		(setq string (epg-decrypt-file context (or local-file
							   filename))
		      length (length string))
		(if replace
		    (goto-char (point-min)))
		(save-excursion
		  (let ((buffer-file-name (if visit nil buffer-file-name)))
		    (save-restriction
		      (narrow-to-region (point) (point))
		      (insert (decode-coding-string string 'undecided)))
		    (if replace
			(delete-region (point) (point-max))))))
	    (when (and local-file (file-exists-p local-file))
	      (delete-file local-file)))))
    ;; If second argument visit is non-nil, the buffer's visited filename
    ;; and last save file modtime are set, and it is marked unmodified.
    (when visit
      (unlock-buffer)
      (setq buffer-file-name filename)
      (set-visited-file-modtime))

    ;; If visiting and the file does not exist, visiting is completed
    ;; before the error is signaled.
    (if (and visit (not (file-exists-p filename)))
	(signal 'file-error (list "Opening input file" filename)))

    ;; Returns list of absolute file name and number of characters inserted.
    (list filename length)))

(put 'write-region 'epg-file 'epg-file-write-region)
(put 'insert-file-contents 'epg-file 'epg-file-insert-file-contents)

(unless (assoc epg-file-name-regexp file-name-handler-alist)
  (setq file-name-handler-alist
	(cons (cons epg-file-name-regexp 'epg-file-handler)
	      file-name-handler-alist)))

(unless (assoc epg-file-name-regexp auto-mode-alist)
  (setq auto-mode-alist
	(cons (list epg-file-name-regexp nil 'strip-suffix)
	      auto-mode-alist)))