remember.l

NetInstaller に公開されているものが既にあるが、自分が使う用に写経&改造。

;;; -*- Mode: Lisp; Package: REMEMBER -*-
;;; 
;;; This files is not part of xyzzy.
;;; 
;;; 
;;; = remember.l
;;; 
;;; == Install
;;; 
;;; (1) Put remember.l on /site-lisp
;;; (2) At .xyzzy
;;;     
;;;       (require "remember")
;;;       (global-set-key '(#\C-c #\m) 'remember)  ; example
;;;     
;;; 
;;; 
;;; == Usage
;;; 
;;; (1) M-x remember RET
;;; (2) Write memo at buffer created at (1)
;;; (3) Save your memo by C-c C-c, or dispose by C-c C-q
;;; 
;;; 
;;; == License
;;; 
;;; Distributes under following terms (modified BSD license):
;;; 
;;; 
;;; Copyright (c) 2009, arikui <arikui.ruby@gmail.com>
;;; All rights reserved.
;;; 
;;; Redistribution and use in source and binary forms, with or without
;;; modification, are permitted provided that the following conditions are met:
;;; 
;;;  * Redistributions of source code must retain the above copyright notice,
;;;    this list of conditions and the following disclaimer.
;;;  * Redistributions in binary form must reproduce the above copyright notice,
;;;    this list of conditions and the following disclaimer in the documentation
;;;    and/or other materials provided with the distribution.
;;;  * Neither the name of the arikui-remember nor the names of its contributors
;;;    may be used to endorse or promote products derived from this software
;;;    without specific prior written permission.
;;; 
;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
;;; AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
;;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
;;; ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
;;; LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
;;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
;;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
;;; CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
;;; ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
;;; POSSIBILITY OF SUCH DAMAGE.
;;;



(provide "remember")
(eval-when (:compile-toplevel :load-toplevel :execute)
  (unless (find-package "remember") (defpackage "remember")))
(in-package "remember")
(use-package "editor")

(export '(remember
	  *remember-mode-hook*
	  *remember-mode-map*
	  *remember-handler-functions*
	  remember-buffer
	  remember-region
	  remember-clipboard
	  remember-interrupt
	  *remember-storage-file*
	  *remember-date-format*
	  *remember-summary-width*))

(defvar *remember-mode-hook* nil "Functions run upon entering remember-mode.")
(defvar *remember-mode-map* nil)
(defvar *remember-handler-functions* '(append-to-file))

(defvar *remember-storage-file*  "~/.remember")
(defvar *remember-date-format*   "%a %b %d %H:%M:%S %Y")
(defvar *remember-summary-width* 60)

(defvar *remember-entry-magic-leading-text* "remember-entry-magic-leading-text")
(defvar *remember-encoding* *encoding-sjis*)
(defvar *remember-eol-code* *eol-crlf*)

(defvar *register* #\R "The register in which the window configuration is stored.")
(defvar *buffer-name* "*Remember*" "The name of the remember data entry buffer.")

(defun key-definitions (k)
  (define-key k '(#\C-c #\C-c) 'remember-buffer)
  (define-key k '(#\C-c #\C-s) 'remember-buffer)
  (define-key k '(#\C-c #\C-q) 'remember-interrupt))


;;; ready working buffer to write memo.
(defun remember ()
  (interactive)
  (save-window-configuration-to-register *register*)
  (let ((buf (get-buffer-create *buffer-name*)))
    (switch-to-buffer-other-window buf)
    (remember-mode)
    (message "Use C-c C-c to memo, C-c C-q to interrupt")))

;;; store buffer content as memo.
(defun remember-buffer ()
  (interactive)
  (remember-region (point-min) (point-max)))

;;; store region content as memo.
(defun remember-region (&optional beg end)
  (interactive)
  (let (buf
	(b (or beg (min (point) (or (mark) (point-min)))))
	(e (or end (max (point) (or (mark) (point-max))))))
    (save-restriction
      (narrow-to-region b e)
      (run-hook-with-args-until-success '*remember-handler-functions*)
      (setf buf (selected-buffer))
      (when (string= *buffer-name* (buffer-name buf))
	(delete-buffer buf)
	(restore-window-configuration-register *register*)))))

;;; store clipboard content as memo.
(defun remember-clipboard ()
  (interactive)
  (remember-with-temp-buffer
   (insert (get-clipboard-data))
   (remember-buffer)))

;;; kill remember buffer without saving memo
(defun remember-interrupt ()
  (interactive)
  (let ((buf (selected-buffer)))
    (when (string= *buffer-name* (buffer-name buf))
      (delete-buffer buf)
      (restore-window-configuration-register *register*))))

;;; major mode for *Remember* buffer based on text-mode
(defun remember-mode ()
  (interactive)
  (kill-all-local-variables)
  (setf buffer-mode 'remember-mode
	mode-name   "remember")
  (setf *remember-mode-map* (copy-keymap *text-mode-map*))
  (key-definitions *remember-mode-map*)
  (use-keymap *remember-mode-map*)
  (use-syntax-table *text-mode-syntax-table*)
  (setq *local-abbrev-table* ed::*text-mode-abbrev-table*)
  (make-local-variable 'highlight-keyword)
  (setq highlight-keyword nil)
  (run-hooks 'remember-mode-hook))


(defmacro remember-with-temp-buffer (&rest body)
  (let ((s (gensym)))
    `(let ((,s (create-new-buffer "*temp*")))
       (save-excursion
	 (setup-temp-buffer ,s)
	 (set-buffer ,s)
	 ,@body
	 (delete-buffer ,s)))))


#| Format
@@@remember-entry-magic-leading-text@@@
@date:formatted-date-string
@summary:summary-content
(whiteline)
following is text...until next entry
|#
(defun append-to-file ()
  (let ((text    (buffer-substring (point-min) (point-max)))
	(summary (buffer-summarize)))
    (remember-with-temp-buffer
     (insert "\n"
	     "@@@" *remember-entry-magic-leading-text* "@@@" "\n"
	     "@date:" (format-date-string *remember-date-format*) "\n"
	     "@summary:" summary "\n"
	     "\n"
	     text)
     (if (not (bolp)) (insert "\n"))
     (if (get-file-buffer *remember-storage-file*)
	 (let ((content (buffer-substring (point-min) (point-max))))
	   (set-buffer (get-file-buffer *remember-storage-file*))
	   (save-excursion
	     (goto-char (point-max))
	     (insert content)
	     (save-buffer)))
       (write-region (point-min) (point-max) *remember-storage-file* t
		     *remember-encoding* *remember-eol-code*)))))

(defun buffer-summarize ()
  (buffer-substring
   (point-min)
   (save-excursion
     (goto-char (point-min))
     (end-of-line)
     (if (> (- (point) (point-min)) *remember-summary-width*)
	 (goto-char (+ (point-min) *remember-summary-width*)))
     (point))))


(in-package "user")
(use-package "remember")