From xemacs-m  Mon Sep 15 17:24:18 1997
Received: from jagor.srce.hr (hniksic@jagor.srce.hr [161.53.2.130])
	by xemacs.org (8.8.5/8.8.5) with ESMTP id RAA21338
	for <xemacs-beta@xemacs.org>; Mon, 15 Sep 1997 17:24:14 -0500 (CDT)
Received: (from hniksic@localhost)
	by jagor.srce.hr (8.8.7/8.8.6) id AAA18293;
	Tue, 16 Sep 1997 00:24:10 +0200 (MET DST)
To: XEmacs Developers <xemacs-beta@xemacs.org>
Subject: abbed: Abbreviations editor
X-Attribution: Hrvoje
X-Face: Mie8:rOV<\c/~z{s.X4A{!?vY7{drJ([U]0O=W/<W*SMo/Mv:58:*_y~ki>xDi&N7XG
        KV^$k0m3Oe/)'e%3=$PCR&3ITUXH,cK>]bci&<qQ>Ff%x_>1`T(+M2Gg/fgndU%k*ft
        [(7._6e0n-V%|%'[c|q:;}td$#INd+;?!-V=c8Pqf}3J
From: Hrvoje Niksic <hniksic@srce.hr>
Date: 16 Sep 1997 00:24:09 +0200
Message-ID: <kig90wycj1y.fsf@jagor.srce.hr>
Lines: 261
X-Mailer: Gnus v5.4.65/XEmacs 20.3(beta20) - "Tirana"

Intensively disliking the default `M-x edit-abbrevs' command in Emacs, 
I have decided to write a widget-based abbreviations editor, abbed.
Try it out and let me know how you like it!

;;; abbed.el -- Alternative abbrevs editor.

;; Copyright (c) 1997 Free Software Foundation

;; Author: Hrvoje Niksic <hniksic@srce.hr>
;; Keywords: abbrev
;; Version: 0.0

;; This file is not yet part of any Emacs.

;; XEmacs 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, or (at your option)
;; any later version.

;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Synched up with: not in FSF

;;; Commentary:

;; The normal Emacs `M-x edit-abbrevs' command is clearly lacking.  It
;; exposes too much of Lisp implementation as well as irrelevant
;; details (usage count, etc.) to the user.  I wrote this as an
;; attempt at a sturdy, user-friendly abbreviation editor for a joe
;; user.

;; The code should work in XEmacs 20.2+, Emacs 20.0+, as well as in
;; older Emacsen with custom and widget libraries.


;;; Code:

(require 'cl)
(require 'widget)
(require 'wid-edit)

(defcustom abbed-default-table 'global-abbrev-table
  "*The default abbrev table to be edited."
  :type 'symbol)

(defvar abbed-keymap (make-sparse-keymap))
(set-keymap-parent abbed-keymap widget-keymap)
(define-key abbed-keymap "q" 'abbed-done)
(define-key abbed-keymap "\C-x\C-s" 'abbed-save)
(define-key abbed-keymap [(meta tab)] 'widget-backward)

(defvar abbed-widget nil)
(defvar abbed-current-table nil)
(defvar abbed-all-abbrevs nil)
(defvar abbed-dirty-tables nil)
(defvar abbed-modified-indicator nil)
(make-variable-buffer-local 'abbed-modified-indicator)


;;; Buffer setup

(defun abbed-setup-buffer (&optional table)
  (kill-buffer (get-buffer-create "*Edit Aliases*"))
  (switch-to-buffer (get-buffer-create "*Edit Aliases*"))
  (setq abbed-current-table (or table abbed-default-table))
  ;; Short documentation.
  (widget-insert "This is an Edit Aliases buffer.\n\n")
  ;; Mode choice.
  (apply 'widget-create 'choice
	 :tag "Mode"
	 :format "%t: %[%v%]"
	 :value abbed-current-table
	 :notify 'abbed-change-table
	 (mapcar (lambda (arg) `(const :format "%t" ,arg))
		 abbrev-table-name-list))
  (widget-insert "\n\n")
  ;; Buttons.
  (widget-create 'push-button
		 :tag "Set"
		 :help-echo "Set the abbreviations"
		 :action 'abbed-set-callback)
  (widget-insert " ")
  (widget-create 'push-button
		 :tag "Set All"
		 :help-echo "Set all the defined abbreviations"
		 :action 'abbed-set-callback)
  (widget-insert " ")
  (widget-create 'push-button
		 :tag "Save"
		 :help-echo "Save abbreviations to disk"
		 :action 'abbed-save-callback)
  (widget-insert " ")
  (widget-create 'push-button
		 :tag "Clear"
		 :help-echo "Clear alias list"
		 :action 'abbed-clear-callback)
  (widget-insert " ")
  (widget-create 'push-button
		 :tag "Done"
		 :help-echo "Exit Editing"
		 :action 'abbed-done-callback)
  (widget-insert "\n\n")
  ;; Main widget with the abbrevs.
  (setq
   abbed-widget
   (widget-create
    'editable-list
    :format "%v%i"
    :entry-format "%i %d %v\n"
    :value (cdr (assq abbed-current-table abbed-all-abbrevs))
    :notify 'abbed-modified-callback
    '(group :format "%v"
	    (editable-field :tag "Abbrev"
			    :format "%[%t%]: %v")
	    (editable-field :tag "Expansion"
			    :format "%[%t%]: %v")
	    (symbol :format "" nil)
	    (integer :format "" 0))))
  (when (memq abbed-current-table abbed-dirty-tables)
    (abbed-draw-indicator))
  ;; setup
  (use-local-map abbed-keymap)
  (widget-setup)
  (set-buffer-modified-p nil)
  (goto-char (point-min)))


;;; Callback functions

(defun abbed-done ()
  "Kill this buffer."
  (interactive)
  (when (or (null abbed-dirty-tables)
	    (yes-or-no-p
	     "There are unsaved changes.  Are you sure you want to exit? "))
    (kill-buffer (current-buffer))))

(defun abbed-done-callback (&rest junk)
  (abbed-done))

(defun abbed-save ()
  "Save the abbreviations to disk."
  (interactive)
  (and abbed-dirty-tables
       (yes-or-no-p "Some changes are unset.  Set them before saving? ")
       (abbed-set-all))
  (call-interactively 'write-abbrev-file))

(defun abbed-save-callback (&rest junk)
  (abbed-save))

(defun abbed-change-table (widget &rest junk)
  (unless (eq (widget-value widget) abbed-current-table))
    (abbed-setup-buffer (widget-value widget)))

(defun abbed-draw-indicator ()
  (unless abbed-modified-indicator
    (save-excursion
      (goto-line 5)
      (end-of-line)
      (widget-insert "  [*]"))
      (setq abbed-modified-indicator t)))

(defun abbed-remove-indicator ()
  (when abbed-modified-indicator
    (save-excursion
      (goto-line 5)
      (end-of-line)
      (let ((inhibit-read-only t)
	    before-change-functions
	    after-change-functions)
	(delete-region (- (point) 5) (point))))
    (setq abbed-modified-indicator nil)))

(defun abbed-modified-callback (&rest junk)
  ;; Update the list
  (setf (cdr (assq abbed-current-table abbed-all-abbrevs))
	(widget-value abbed-widget))
  (pushnew abbed-current-table abbed-dirty-tables)
  (abbed-draw-indicator))

(defun abbed-activate-table (table)
  (setq table (symbol-value table))
  (clear-abbrev-table table)
  (mapc (lambda (abbrev)
	  (apply 'define-abbrev
		 (symbol-value table) abbrev))
	(cdr (assq table abbed-all-abbrevs))))

(defun abbed-set-callback (widget &rest junk)
  (abbed-activate-table abbed-current-table)
  (setq abbed-dirty-tables (delq abbed-current-table abbed-dirty-tables))
  (abbed-remove-indicator))

(defun abbed-set-all ()
  (mapc #'abbed-activate-table abbed-dirty-tables)
  (setq abbed-dirty-tables nil)
  (abbed-remove-indicator))

(defun abbed-set-all-callback (&rest junk)
  (abbed-set-all))

(defun abbed-clear-callback (widget &rest junk)
  (widget-value-set abbed-widget nil)
  (abbed-modified-callback)
  (widget-setup))


(defun abbed-convert-abbrevs-1 (table)
  (and (symbolp table)
       (setq table (symbol-value table)))
  (let (res)
    (mapatoms (lambda (sym)
		(unless (equal (symbol-name sym) " ")
		  (push (list (symbol-name sym)
			      (symbol-value sym)
			      (symbol-function sym)
			      (symbol-plist sym))
			res)))
	      table)
    (sort* res #'string-lessp
	   :key #'car)))

(defun abbed-convert-abbrevs ()
  (mapcar (lambda (table)
	    (cons table (abbed-convert-abbrevs-1 table)))
	  abbrev-table-name-list))

(defun abbed (&optional table)
  (interactive (list (completing-read
		      "Mode table: "
		      (mapcar (lambda (arg)
				(list (symbol-name arg)))
			      abbrev-table-name-list))))
  (setq table (if (or (null table)
		      (equal table ""))
		  'global-abbrev-table
		(intern table)))
  (unless (memq table abbrev-table-name-list)
    (define-abbrev-table table nil))
  (setq abbed-all-abbrevs (abbed-convert-abbrevs)
	abbed-dirty-tables nil
	abbed-modified-indicator nil
	abbed-widget nil)
  (abbed-setup-buffer table))

;;; abbed.el ends here


-- 
Hrvoje Niksic <hniksic@srce.hr> | Student at FER Zagreb, Croatia
--------------------------------+--------------------------------
The end of the world is coming...  SAVE YOUR BUFFERS!

