wotd.el 1.1.1

[Kevin A. Burton]

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


;; Tue Feb 05 2002 11:59 PM (address@hidden): Version 1.1.1 doesnt' use
;; font-lock but uses 'face properties for necessary text.


;;; wotd.el --- Programmable word of the day package for Emacs

;; $Id: wotd.el,v 1.9 2001/09/10 10:16:19 burton Exp $

;; Copyright (C) 2000-2003 Free Software Foundation, Inc.
;; Copyright (C) 2000-2003 Kevin A. Burton (address@hidden)

;; Author: Kevin A. Burton (address@hidden)
;; Maintainer: Kevin A. Burton (address@hidden)
;; Location: http://relativity.yi.org
;; Keywords:
;; 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:
;;
;; Quick (but nice) hack to support user words of the day.  Basically if you
;; want an easy way to remember words then this is your package.  You just add
;; words to it and everytime you run 'wotd' it will randomly show you the
;; definition of one of them.  By default there only only two words "GNU" and
;; "Emacs" so these probably aren't to useful to most users.
;;
;; It requires the dict package to do dictionary lookups.  This should be
;; available on most list archives or through google.
;;
;; If you like it, buy me a Ferrari, or give money to the EFF
;; (http://www.eff.org)

;;; Install:
;;
;; Do a (require 'wotd) and use the wotd, wotd-add and wotd-delete functions.
;;
;; You will also need to install the Emacs dictionary:
;;   http://me.in-berlin.de/~myrkr/dictionary.html

;;; History:
;;
;; Tue Feb 05 2002 11:59 PM (address@hidden): Version 1.1.1 doesnt' use
;; font-lock but uses 'face properties for necessary text.
;;
;; Mon Aug 27 2001 01:40 AM (address@hidden): Version 1.1 uses a new
;; file name .wotd.el for both emacs conformance and compatibility with 1.0.
;;
;; Mon Aug 27 2001 12:25 AM (address@hidden): Version 1.1 adds support
;; for keeping the words *inside* the list.

;;; TODO:
;;
;; - need to snarf dictionary words WHEN I create/add a word.  This way it is
;; available when I need to pull it up (and I don't have access to dict).
;;
;; - merge this over to using customization...

(require 'dict)

(require 'font-lock)

;;; Code:
(defvar wotd-alist '() "Lists of words for wotd.")

(defvar wotd-file "~/.wotd.el" "File use for wotd persistence.")

(defvar wotd-definition-buffer-name "*wotd-definition*"
  "Buffer name used for prompting for definitions.")

(defvar wotd-definition-current-word nil "Current word in the definition 
buffer.")
(make-variable-buffer-local 'wotd-definition-current-word)

(defvar wotd-buffer-name "*wotd*"
  "Buffer name used for prompting for definitions.")

(defun wotd()
  "Display a word of the day."
  (interactive)

  (assert (> (length wotd-alist) 0)
          nil "Word list is not defined.  Add a new word.")
  
  (let(random-index
       word-cell
       word)

    (setq random-index (random (length wotd-alist)))

    (setq word-cell (elt wotd-alist random-index))
    
    (setq word (symbol-name (car word-cell)))

    (wotd-edit word)))
    
(defun wotd-add(word)
  "Add a word."
  (interactive
   (list
    (read-string "Word: ")))

  (if (assoc (intern word) wotd-alist)
      (error (format "The Word '%s' is already in the word list."
                     word)))
  
  (wotd-prompt-definition word))

(defun wotd-add-manually(word)
  ""
  (interactive
   (list
    (read-string "Word: ")))

    (if (assoc (intern word) wotd-alist)
      (error (format "The Word '%s' is already in the word list."
                     word)))
  
  (wotd-prompt-definition word ""))

(defun wotd-delete()
  "Delete a word"
  (interactive)

  (let(word)
    
    (setq word (wotd-get-word))

    (setq wotd-alist (delq (assoc (intern word) wotd-alist) wotd-alist))

    (wotd-save)
    
    (message "Delted '%s' from word list" word)))

(defun wotd-edit(word)
  "Edit a word's definition and save it."
  (interactive
   (list
    (wotd-get-word)))

  (assert word
          nil "Must specify a word")
  
  (let(cell definition)
  
    (setq cell (assoc (intern word) wotd-alist))

    (setq definition (cdr cell))

    (wotd-prompt-definition word definition)))

(defun wotd-save()
  "Save the word list."
  (interactive)
  
  (message "Saving wotd...")

  (let(buffer)

    (setq buffer (find-file-literally wotd-file))

    (set-buffer buffer)

    (erase-buffer)

    (insert "(setq wotd-alist '")
    (prin1 wotd-alist (current-buffer))
    (insert ")")

    (save-buffer)
    (kill-buffer buffer))

  (message "Saving wotd...done"))

(defun wotd-restore()
  "Restore wotd data from disk."

  (if (file-exists-p wotd-file)
      (load-file wotd-file)))

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

  ;;build a list for completion
  (let((i 0)
       word completion-list)

    (while (< i (length wotd-alist))

      (setq word (symbol-name (elt (elt wotd-alist i) 0)))

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

    (completing-read "Word: " completion-list nil t)))

(defun wotd-prompt-definition(word &optional definition)
  "Prompt for a definition for this word in a dedicated buffer and complete the
editing process.  If the definition is nil we will try to use the dict servers
for this."

  (let(buffer)

    (setq buffer (get-buffer-create wotd-definition-buffer-name))

    (pop-to-buffer buffer)
    
    (set-buffer buffer)

    (erase-buffer)

    (let(comment)

      (setq comment (format "// Definition for '%s'\n" word))

      (add-text-properties 0 (length comment) '(face font-lock-comment-face) 
comment)
      
      (insert comment))
    
    (if definition
        (insert definition)
      
      (save-excursion

        ;;FIXME: The 'dict' package uses the dict HTTP servers but not the dict
        ;;protocol.  The dictionary-search packages *does* use the dict protocol
        ;;but doesn't have a nice API.
        
        (dict-fetch word)
        (dict-wash)))

    (beginning-of-buffer)
    
    (wotd-definition-mode)
    
    (setq wotd-definition-current-word word)))

(defun wotd-definition-save()
  "Save the current definition."
  (interactive)

  )

(defun wotd-prompt-definition-complete()
  "Complete prompting for the definition and add it."
  (interactive)

  (save-excursion

    (let(word definition)
      
      (set-buffer wotd-definition-buffer-name)

      (wotd--wash)
  
      (setq word wotd-definition-current-word)

      (assert word
              nil "Word may not be null")
      
      (setq definition (buffer-substring (point-min) (point-max)))

      (set-buffer-modified-p nil)

      (kill-buffer wotd-definition-buffer-name)

      (other-window 1)

      (delete-other-windows)
      
      (add-to-list 'wotd-alist (cons (intern word) definition))
      
      (wotd-save)
      
      (message "Added '%s' to word list" word))))

(defun wotd--wash()
  "Wash comments from the edit buffer"
  
  (save-excursion
    (beginning-of-buffer)

    (while (re-search-forward "^//.*$" nil t)
      (delete-region (match-beginning 0) (1+ (match-end 0))))))

(define-derived-mode wotd-definition-mode fundamental-mode "Definition"
  "Buffer for entering definitions."

  (message "Enter or view a definition.  Type C-c C-c when complete to save."))

(wotd-restore)

(define-key wotd-definition-mode-map "\C-c\C-c" 
'wotd-prompt-definition-complete)

(provide 'wotd)

;;; wotd.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/

Windows XP.  Now with more evil in every box!

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

iD8DBQE8YOLBAwM6xb2dfE0RAvcSAJ4/1FDTkC3Kp95OKSo2f9e7RB6CYQCgilTM
+ylq4opD4ID0o1F5+ERahaw=
=1KiK
-----END PGP SIGNATURE-----