clipper.el 1.1.1

[Kevin A. Burton]

-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1



;; - Wed Jan 30 2002 03:14 PM (address@hidden): fixed a bug WRT data
;; loss when editing existing clips.


;;; clipper.el --- save strings of data for further use.

;; Copyright (C) 1997-2000 Free Software Foundation, Inc.

;; Author: Kevin A. Burton (address@hidden)
;; Maintainer: Kevin A. Burton (address@hidden)
;; Location: http://relativity.yi.org
;; Keywords: clip save text
;; Version: 1.1.1

;; This file is [not yet] part of GNU Emacs.

;; 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 of the License, or 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; if not, write to the Free Software Foundation, Inc., 59 Temple
;; Place - Suite 330, Boston, MA 02111-1307, USA.

;;; Commentary:

;; Clipper is a way to handle 'clips' of text with some persistance via handles.
;; A good example is something like the GNU Public License.  If you do a lot of
;; Free Software work and need to have a copy of the GPL for insertion in your
;; source files, you can save this text as a 'GPL' clip.  When you call
;; clipper-insert you will be prompted for a name and when you enter GPL this
;; will be inserted.
;;
;; Clipper can also perform search and replacement on token names.  For example
;; if want the current buffer filename you can use the token
;; CLIPPER_FILE_NAME_NONDIRECTORY.
;;
;; Available tokens are:
;;
;;     CLIPPER_FILE_NAME_NONDIRECTORY
;;
;;         The current filename without it's directory.  If this buffer isn't
;;         backed on disk then the buffer name is used.
;;
;;     CLIPPER_FILE_NAME_NONDIRECTORY_SANS_EXTENSION
;;
;;         The current filename without it's directory and without an extension.

;;; Usage:
;;
;; install via (require 'clipper) in your .emacs file.
;;
;; The following functions allow you to manipulate clipper:
;;
;; `clipper-create' create a new clip
;;
;; `clipper-delete' delete an existing clip
;;
;; `clipper-insert' insert a clip into the current buffer
;;
;; `clipper-edit-clip' edit an existing clip.
;;
;; You might also want to setup personal key bindings:
;;
;; (global-set-key "\C-cci" 'clipper-insert)
;; (global-set-key "\C-ccc" 'clipper-create)

;;; TODO

;; sort the alist with `sort'

;;; History:
;;
;; - Wed Jan 30 2002 03:14 PM (address@hidden): fixed a bug WRT data
;; loss when editing existing clips.
;; 
;; - Sun Nov 04 2001 05:33 PM (address@hidden): we are now supporting a
;; file-name-nondirectory in special buffers.
;;
;; - Sun Nov 04 2001 05:31 PM (address@hidden): clipper-save was not
;; smart enough.  We now save-excursion, use find-file-noselect and localize
;; find-file-hooks so that saves are cleaner and faster.
;; 
;; - Sat Mar 17 00:02:18 2001 (address@hidden): migrate to load-file
;; instead of manually evaluating the file
;; 
;; - Tue Jan  2 03:51:45 2001 (burton): Version 1.0.1.  Added support for 
editing
;;   clips thanks to a prototype function provided by Joe Humrickhouse
;;   <address@hidden> which was modularized with the current creation
;;   function.  Added fontlock for the input buffer.

;;
;;; Code:

(require 'font-lock)

(defvar clipper-alist '() "Associated list for holding clips.")

(defvar clipper-file "~/.clipper" "File used for saving clipper information.")

(defvar clipper-input-buffer "*clipper input*" "Buffer used for entering new 
clips.")

(defvar clipper-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map "\C-c\C-c" 'clipper-complete-input)
    map)
  "Mode specific keymap for `clipper-mode'.")

(defvar clipper-mode-string "Clipper" "Mode name for clipper.")

(defvar clipper-input-message "" "Value for the clipper input buffer.")
(if (equal clipper-input-message "")
    (setq clipper-input-message
          (concat clipper-input-message
                  "CLIPPER: 
--------------------------------------------------------------------------\n"
                  "CLIPPER: Lines beginning with `CLIPPER:' are removed 
automatically.\n"
                  "CLIPPER: Enter new clip.  Type C-c C-c when complete.\n"
                  "CLIPPER: \n"
                  "CLIPPER: The following variables are supported: \n"
                  "CLIPPER: \n"
                  "CLIPPER:      CLIPPER_FILE_NAME_NONDIRECTORY\n"
                  "CLIPPER: \n"
                  "CLIPPER:         The current filename without it's 
directory.  If this buffer isn't\n"
                  "CLIPPER:         backed on disk then the buffer name is 
used.\n"
                  "CLIPPER: \n"
                  "CLIPPER:      
CLIPPER_FILE_NAME_NONDIRECTORY_SANS_EXTENSION\n"
                  "CLIPPER: \n"
                  "CLIPPER:         The current filename without it's directory 
and without an extension\n"
                  "CLIPPER: \n")))

(defun clipper-save()
  "Save the clipper information to file."

  (save-excursion

    (let((find-file-hooks nil))    
    
      (set-buffer (find-file-noselect clipper-file))
      
      ;;whatever is in this buffer is now obsolete
      (erase-buffer)

      (insert "(setq clipper-alist '")
      (prin1 clipper-alist (current-buffer))
      (insert ")")
      (save-buffer)
      (kill-buffer (current-buffer))
      
      (message "Wrote %s" clipper-file))))
  
(defun clipper-delete()
  "Delete an existing 'clip'"
  (interactive)

  (let (clip)

    ;; get the clipper to delete
    (setq clip (clipper-get-clip))

    (if (yes-or-no-p (format "Are you sure you want to delete clip: %s? " clip))
        (progn

          ;;remove it...
          (setq clipper-alist (delq (assoc (intern clip) clipper-alist) 
clipper-alist))
          
          ;;save the alist to disk
          (clipper-save)))))

(defun clipper-create()
  "Create a new 'clip' for use within Emacs"
  (interactive)

  (set-buffer (get-buffer-create clipper-input-buffer))
  (erase-buffer) ;; just in case

  (clipper-mode)

  (setq clipper-clip-name (read-string "Name of new clip: "))

  ;;make sure the clip that the user just specified doesn't already exist.
  (if (null (assoc (intern clipper-clip-name) clipper-alist))
      (progn

        (insert clipper-input-message)

        (pop-to-buffer clipper-input-buffer)
        (end-of-buffer)

        (message "Enter new clip.  Type C-c C-c when complete."))
    (error "The specified clip already exists")))

(defun clipper-complete-input()
  "Called when the user is done entering text. "
  (interactive)
  
  (set-buffer (get-buffer-create clipper-input-buffer))

  ;;make sure font-lock is off in this buffer
  (font-lock-mode -1)
  
  ;;clean up the input buffer by removing comment lines.
  (save-excursion
    (beginning-of-buffer)
    (while (re-search-forward "^CLIPPER: .*$" nil t)
      (delete-region (match-beginning 0) (match-end 0))
      (kill-line 1)))

  ;;now get the value of the buffer.
  (let(clipper-input begin end)

    (save-excursion
      (beginning-of-buffer)
      (setq begin (point))
      (end-of-buffer)
      (setq end (point)))

    (setq clipper-input (buffer-string))

    (add-to-list 'clipper-alist (cons (intern clipper-clip-name) 
clipper-input)))

  ;;now clean up...
  (kill-buffer clipper-input-buffer)
  (delete-window)

  (clipper-save))

(defun clipper-insert(clip-name)
  "Insert a new 'clip' into the current buffer"
  (interactive
   (list
    (clipper-get-clip)))

  (let (value insert-start insert-end)

    ;;the insert start and insert end variables keep track of where things were
    ;;inserted.
    
    (setq insert-start (point))
    
    (setq value (assoc (intern clip-name) clipper-alist))

    (insert (cdr value))

    (setq insert-end (point))

    (clipper-replace-tokens insert-start insert-end)))

(defun clipper-mode()
  "Mode for entering data into a 'clip'."

  (kill-all-local-variables)
  (use-local-map clipper-mode-map)

  (setq major-mode 'clipper-mode)
  (setq mode-name clipper-mode-string)

  (setq clipper-mode t)

  (run-hooks 'clipper-mode-hook)
  (font-lock-mode 1))

(defun clipper-restore()
  "Read the clipper data file from disk"
  (if (file-readable-p clipper-file)
      (let(buffer)
        (message "Reading %s..." clipper-file)
        
        (load-file clipper-file)
        
        (message "Reading %s...done" clipper-file))))

(defun clipper-get-clip()
  "Use completion to ask the user for a clip"

  ;;build a list for completion
  (let(clip i completion-list)

    (setq i 0)
    ;;(setq
    
    (while (< i (safe-length clipper-alist))

      (setq clip (symbol-name (car (nth i clipper-alist))))

      (add-to-list 'completion-list
                   (list clip 1))
      
      (setq i (1+ i)))

    (setq my-clipper-test completion-list)
    
    (completing-read "Clip name: " completion-list nil t)))

(defun clipper-edit-clip()
  "Edit an existing clip.  Note that your clip MUST be saved even if
you don't edit it.  Otherwise the clip will be DELETED for good."

  (interactive)

  (set-buffer (get-buffer-create clipper-input-buffer))
  (erase-buffer)
  (clipper-mode)

  (setq clipper-clip-name (clipper-get-clip))

  (insert clipper-input-message)
  (setq value (assoc (intern clipper-clip-name) clipper-alist))
  (insert (cdr value))
  (pop-to-buffer clipper-input-buffer)
  (beginning-of-buffer))

(defun clipper-replace-tokens(start end)
  "Search and replace clipper tokens in this buffer."

  (save-excursion
    (save-restriction

      (narrow-to-region start end)

      (beginning-of-buffer)

      (let(file-name-nondirectory file-name-nondirectory-san-extension)

        (if (buffer-file-name)
            (setq file-name-nondirectory (file-name-nondirectory 
(buffer-file-name)))
          (setq file-name-nondirectory (buffer-name)))

        (if (null file-name-nondirectory)
            (setq file-name-nondirectory (buffer-name)))

        (setq file-name-nondirectory-san-extension (file-name-sans-extension 
file-name-nondirectory))
        
        ;;---------
        ;;setup the file-name-nondirectory extension
        (save-excursion

          (beginning-of-buffer)
          
          (while (re-search-forward " \\(CLIPPER_FILE_NAME_NONDIRECTORY\\) " 
nil t)
            (replace-match file-name-nondirectory t nil nil 1)))

        ;;---------
        (save-excursion

          (beginning-of-buffer)

          (while (re-search-forward 
"\\(CLIPPER_FILE_NAME_NONDIRECTORY_SANS_EXTENSION\\)" nil t)

            (replace-match file-name-nondirectory-san-extension t nil nil 
1)))))))

;;initialze clipper
(clipper-restore)

(font-lock-add-keywords 'clipper-mode '(("\\(^CLIPPER.*\\)" 1 
'font-lock-comment-face t)))

(provide 'clipper)

;;; clipper.el ends here

- -- 
Kevin A. Burton ( address@hidden, address@hidden, address@hidden )
             Location - San Francisco, CA, Cell - 415.595.9965
        Jabber - address@hidden,  Web - http://relativity.yi.org/

The End of Innovation?

  http://www.openp2p.com/pub/a/p2p/2001/08/07/lessig.html

-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1.0.6 (GNU/Linux)
Comment: Get my public key at: http://relativity.yi.org/pgpkey.txt

iD8DBQE8WH6SAwM6xb2dfE0RAoRNAJ9WV3t4GNwoHA3vDtcCjknr5QLoNQCgmCiX
Th1MJ1X3ibXrHAsIG1KjnfQ=
=LcOT
-----END PGP SIGNATURE-----