(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-invoke-default-handler operation args))))

(defun epg-file-invoke-default-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)))

(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-invoke-default-handler
			     #'write-region
			     (list start end "/"))
                          (file-error 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
      (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 (memq system-type '(ms-dos windows-nt))
	      (setq buffer-file-type t))
	  (epg-file-invoke-default-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))
    (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)

  ;; If visit is non-nil, beg and end must be nil.
  (if (and visit (or beg end))
      (error "Attempt to visit less than an entire file"))

  (let ((expanded-filename (expand-file-name filename))
	(length 0))
    (if (file-exists-p expanded-filename)
	(let* ((local-copy (epg-file-invoke-default-handler
			    'file-local-copy
			    (list expanded-filename)))
	       (local-file (or local-copy expanded-filename))
	       (coding-system-for-read 'binary)
	       (context (epg-make-context))
	       string)
	  (unwind-protect
	      (progn
		(setq string (epg-decrypt-file context local-file)
		      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 string)
		      (epg-file-decode-coding-inserted-region
		       (point-min) (point-max)
		       expanded-filename
		       visit beg end replace))
		    (if replace
			(delete-region (point) (point-max))))))
	    (when (and local-copy (file-exists-p local-copy))
	      (delete-file local-copy)))))
    ;; 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 expanded-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 expanded-filename)))
	(signal 'file-error (list "Opening input file" filename)))

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

(if (fboundp 'decode-coding-inserted-region)
    (defalias 'epg-file-decode-coding-inserted-region 'decode-coding-inserted-region)
  (defun epg-file-decode-coding-inserted-region (from to filename
                                                 &optional visit beg end replace)
    "Decode the region between FROM and TO as if it is read from file FILENAME.
The idea is that the text between FROM and TO was just inserted somehow.
Optional arguments VISIT, BEG, END, and REPLACE are the same as those
of the function `insert-file-contents'.
Part of the job of this function is setting `buffer-undo-list' appropriately."
  (save-excursion
    (save-restriction
      (let ((coding coding-system-for-read)
            undo-list-saved)
        (if visit
            ;; Temporarily turn off undo recording, if we're decoding the
            ;; text of a visited file.
            (setq buffer-undo-list t)
          ;; Otherwise, if we can recognize the undo elt for the insertion,
          ;; remove it and get ready to replace it later.
          ;; In the mean time, turn off undo recording.
          (let ((last (car-safe buffer-undo-list)))
            (if (and (consp last) (eql (car last) from) (eql (cdr last) to))
                (setq undo-list-saved (cdr buffer-undo-list)
                      buffer-undo-list t))))
        (narrow-to-region from to)
        (goto-char (point-min))
        (or coding
            (setq coding (funcall set-auto-coding-function
                                  filename (- (point-max) (point-min)))))
        (or coding
            (setq coding (car (find-operation-coding-system
                               'insert-file-contents
                               filename visit beg end replace))))
        (if (coding-system-p coding)
            (or enable-multibyte-characters
                (setq coding
                      (coding-system-change-text-conversion coding 'raw-text)))
          (setq coding nil))
        (if coding
            (decode-coding-region (point-min) (point-max) coding)
          (setq last-coding-system-used coding))
        ;; If we're decoding the text of a visited file,
        ;; the undo list should start out empty.
        (if visit
            (setq buffer-undo-list nil)
          ;; If we decided to replace the undo entry for the insertion,
          ;; do so now.
          (if undo-list-saved
              (setq buffer-undo-list
                    (cons (cons from (point-max)) undo-list-saved)))))))))
      
(put 'epg-file-handler 'safe-magic t)
(let (epg-file-operations)
  (mapc
   (lambda (operation)
     (let ((epg-file-operation (intern (format "epg-file-%s" operation))))
       (when (fboundp epg-file-operation)
         (push operation epg-file-operations)
         (put operation 'epg-file epg-file-operation))))
   '(access-file add-name-to-file byte-compiler-base-file-name copy-file
     delete-directory delete-file  diff-latest-backup-file directory-file-name
     directory-files directory-files-and-attributes dired-call-process
     dired-compress-file dired-uncache expand-file-name
     file-accessible-directory-p file-attributes file-directory-p
     file-executable-p file-exists-p file-local-copy file-remote-p file-modes
     file-name-all-completions file-name-as-directory file-name-completion
     file-name-directory file-name-nondirectory file-name-sans-versions
     file-newer-than-file-p file-ownership-preserved-p file-readable-p
     file-regular-p file-symlink-p file-truename file-writable-p
     find-backup-file-name find-file-noselect get-file-buffer
     insert-directory insert-file-contents load make-directory
     make-directory-internal make-symbolic-link rename-file set-file-modes
     set-visited-file-modtime shell-command substitute-in-file-name
     unhandled-file-name-directory vc-registered verify-visited-file-modtime
     write-region))
  (put 'epg-file-handler 'operations epg-file-operations))

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

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