[Top][All Lists]

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]


From: Kevin A. Burton
Subject: clipper.el
Date: 29 Oct 2001 17:13:45 -0800
User-agent: Gnus/5.0808 (Gnus v5.8.8) Emacs/21.1

Hash: SHA1

misc bug fixes.

;;; 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:
;; Keywords: clip save text
;; Version: 1.0.2

;; 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
;; Available tokens are:
;;         The current filename without it's directory.  If this buffer isn't
;;         backed on disk then the buffer name is used.
;;         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:
;; - 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 
;;   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 

(defvar clipper-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map "\C-c\C-c" 'clipper-complete-input)
  "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: Lines beginning with `CLIPPER:' are removed 
                  "CLIPPER: Enter new clip.  Type C-c C-c when complete.\n"
                  "CLIPPER: \n"
                  "CLIPPER: The following variables are supported: \n"
                  "CLIPPER: \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 
                  "CLIPPER: \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."

  (find-file clipper-file)
  ;;whatever is in this buffer is now obsolete

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

  (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))

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

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

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


  (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))

        (insert clipper-input-message)

        (pop-to-buffer clipper-input-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. "
  (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.
    (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)

      (setq begin (point))
      (setq end (point)))

    (setq clipper-input (buffer-string))

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

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


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

  (let (value insert-start insert-end)

    ;;the insert start and insert end variables keep track of where things were
    (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'."

  (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)
        (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)
    (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."


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

  (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)
  (setq clipper-alist 
        (delq (assoc (intern clipper-clip-name) clipper-alist) clipper-alist)))

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


      (narrow-to-region start end)


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

        (setq file-name-nondirectory (file-name-nondirectory 

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

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

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



          (while (re-search-forward 

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

;;initialze clipper

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

(provide 'clipper)

;;; clipper.el ends here

- -- 
  Need a good Engineer?  Hire me!  ( Java | P2P | XML | Linux | Open Source )


Kevin A. Burton ( address@hidden, address@hidden, address@hidden )
             Location - San Francisco, CA, Cell - 415.595.9965
        Jabber - address@hidden,  Web -

Don't work on closed source software.  It is immoral.

Version: GnuPG v1.0.6 (GNU/Linux)
Comment: Get my public key at:


reply via email to

[Prev in Thread] Current Thread [Next in Thread]