view lisp/net/eudc-hotlist.el @ 106619:528f9cf7298f

Update dependencies in Makefile.in. (alloc.o): Depend on termhooks.h. (atimer.o): Depend on blockinput.h. (buffer.o): Depend on indent.h, keyboard.h, coding.h, keymap.h, and frame.h. (callint.o): Depend on systime.h, coding.h, and composite.h. (callproc.o): Depend on buffer.h. (casefiddle.o): Don't depend on charset.h. (casetab.o): Depend on character.h. (ccl.o): Depend on composite.h. (chartab.o): Depend on ccl.h. (cm.o): Depend on dispextern.h. (cmds.o): Depend on systime.h, coding.h, frame.h, and composite.h. (coding.o): Don't depend on $(INTERVALS_H). (composite.o): Don't depend on dispextern.h explicitly (it's in $(INTERVALS_H)). Depend on ccl.h. (data.o): Depend on systime.h, coding.h, composite.h, dispextern.h, font.h, and ccl.h. (dired.o): Depend on composite.h. (dispnew.o): Depend on coding.h. Don't depend explicitly on composite.h (it's in $(INTERVALS_H)). (doc.o): Depend on systime.h, coding.h, and composite.h. (editfns.o): Don't depend explicitly on dispextern.h. (emacs.o): Depend on frame.h and coding.h. (eval.o): Depend on coding.h, composite.h, and xterm.h. (fileio.o): Depend on frame.h and commands.h. Don't depend explicitly on dispextern.h. (filelock.o): Don't depend on epaths.h and charset.h. Depend on composite.h. (fns.o): Don't depend on termhooks.h. (font.o): Depend on buffer.h, composite.h, fontset.h, and xterm.h. (fontset.o): Depend on blockinput.h, atimer.h, systime.h, coding.h, $(INTERVALS_H), window.h, xterm.h. (frame.o): Depend on coding.h, composite.h, termhooks.h, and ccl.h. (fringe.o): Depend on blockinput.h, atimer.h, and systime.h. (ftfont.o): Depend on blockinput.h, atimer.h, systime.h, coding.h, fontset.h, ccl.h, and ftfont.h. (ftxfont.o): Depend on atimer.h, systime.h, fontset.h, and ccl.h. (gtkutil.o): Depend on dispextern.h and composite.h. (image.o): Depend on epaths.h, character.h, coding.h, composite.h, termhooks.h, and ccl.h. (indent.o): Depend on systime.h, coding.h, and $(INTERVALS_H). (intervals.o): Depend on systime.h and coding.h. (keyboard.o): Depend on composite.h and coding.h. (keymap.o): Depend on coding.h and frame.h. (lread.o): Depend on systime.h, frame.h, blockinput.h, and atimer.h. (macros.o): Depend on systime.h, coding.h, and composite.h. (menu.o): Depend on systime.h, coding.h, composite.h, window.h, and atimer.h. (minibuf.o): Depend on systime.h and coding.h. Don't depend on dispextern.h explicitly. (print.o): Depend on termhooks.h, coding.h, and ccl.h. Don't depend explicitly on dispextern.h and composite.h. (process.o): Depend on character.h, xgselect.h, and sysselect.h. (regex.o): Don't depend on charset.h. (scroll.o): Depend on systime.h, coding.h, composite.h, and window.h. (search.o): Don't depend explicitly on composite.h. (sound.o): Depend on atimer.h and systime.h. (syntax.o): Don't depend explicitly on composite.h. (sysdep.o): Depend on coding.h and composite.h. (term.o): Depend on xterm.h and buffer.h. (terminal.o): Depend on dispextern.h, composite.h, and systime.h. (textprop.o): Don't depend on dispextern.h explicitly. (undo.o): Depend on dispextern.h. (window.o): Depend on coding.h and termhooks.h. Don't depend on dispextern.h and composite.h explicitly. (xdisp.o): Depend on ccl.h. (xfaces.o): Depend on coding.h and ccl.h. (xfns.o): Depend on $(INTERVALS_H) and ccl.h. (xfont.o): Depend on atimer.h, systime.h, fontset.h, and ccl.h. (xftfont.o): Depend on atimer.h, systime.h, fontset.h, ccl.h, and ftfont.h. (xgselect.o): New dependency. (xmenu.o): Depend on composite.h, keymap.h, and sysselect.h. (xselect.o): Depend on keyboard.h, coding.h, and composite.h. (xsettings.o): Depend on dispextern.h, keyboard.h, systime.h, coding.h, composite.h, blockinput.h, atimer.h, and termopts.h. (xsmfns.o): Depend on frame.h and dispextern.h. (xterm.o): Depend on intervals.h, keymap.h, xgselect.h, and sysselect.h.

;;; eudc-hotlist.el --- hotlist management for EUDC

;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;;   2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.

;; Author: Oscar Figueiredo <[e-mail]>
;; Maintainer: Pavel Janík <[e-mail]>
;; Keywords: comm

;; This file is part of GNU Emacs.

;; GNU Emacs 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 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs 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 GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;;; Usage:
;;    See the corresponding info file

;;; Code:

(require 'eudc)

(defvar eudc-hotlist-menu nil)
(defvar eudc-hotlist-mode-map nil)
(defvar eudc-hotlist-list-beginning nil)

(defun eudc-hotlist-mode ()
  "Major mode used to edit the hotlist of servers.

These are the special commands of this mode:
    a -- Add a new server to the list.
    d -- Delete the server at point from the list.
    s -- Select the server at point.
    t -- Transpose the server at point and the previous one
    q -- Commit the changes and quit.
    x -- Quit without commiting the changes."
  (interactive)
  (kill-all-local-variables)
  (setq major-mode 'eudc-hotlist-mode)
  (setq mode-name "EUDC-Servers")
  (use-local-map eudc-hotlist-mode-map)
  (when (featurep 'xemacs)
    (setq mode-popup-menu eudc-hotlist-menu)
    (when (featurep 'menubar)
      (set-buffer-menubar current-menubar)
      (add-submenu nil (cons "EUDC-Hotlist" (cdr (cdr eudc-hotlist-menu))))))
  (setq buffer-read-only t)
  (run-mode-hooks 'eudc-hotlist-mode-hook))

;;;###autoload
(defun eudc-edit-hotlist ()
  "Edit the hotlist of directory servers in a specialized buffer."
  (interactive)
  (let ((proto-col 10)
	gap)
    (switch-to-buffer (get-buffer-create "*EUDC Servers*"))
    (setq buffer-read-only nil)
    (erase-buffer)
    (mapc (function
	   (lambda (entry)
	     (setq proto-col (max (length (car entry)) proto-col))))
	  eudc-server-hotlist)
    (setq proto-col (+ 3 proto-col))
    (setq gap (make-string (- proto-col 6) ?\ ))
    (insert "              EUDC Servers\n"
	    "              ============\n"
	    "\n"
	    "Server" gap "Protocol\n"
	    "------" gap "--------\n"
	    "\n")
    (setq eudc-hotlist-list-beginning (point))
    (mapc '(lambda (entry)
	     (insert (car entry))
	     (indent-to proto-col)
	     (insert (symbol-name (cdr entry)) "\n"))
	  eudc-server-hotlist)
  (eudc-hotlist-mode)))

(defun eudc-hotlist-add-server ()
  "Add a new server to the list after current one."
  (interactive)
  (if (not (eq major-mode 'eudc-hotlist-mode))
      (error "Not in a EUDC hotlist edit buffer"))
  (let ((server (read-from-minibuffer "Server: "))
	(protocol (completing-read "Protocol: "
				   (mapcar '(lambda (elt)
					      (cons (symbol-name elt)
						    elt))
					   eudc-known-protocols)))
	(buffer-read-only nil))
    (if (not (eobp))
	(forward-line 1))
    (insert server)
    (indent-to 30)
    (insert protocol "\n")))

(defun eudc-hotlist-delete-server ()
  "Delete the server at point from the list."
  (interactive)
  (if (not (eq major-mode 'eudc-hotlist-mode))
      (error "Not in a EUDC hotlist edit buffer"))
  (let ((buffer-read-only nil))
    (save-excursion
      (beginning-of-line)
      (if (and (>= (point) eudc-hotlist-list-beginning)
	       (looking-at "^\\([-.a-zA-Z:0-9]+\\)[ \t]+\\([a-zA-Z]+\\)"))
	  (kill-line 1)
	(error "No server on this line")))))

(defun eudc-hotlist-quit-edit ()
  "Quit the hotlist editing mode and save changes to the hotlist."
  (interactive)
  (if (not (eq major-mode 'eudc-hotlist-mode))
      (error "Not in a EUDC hotlist edit buffer"))
  (let (hotlist)
    (goto-char eudc-hotlist-list-beginning)
    (while (looking-at "^\\([-.a-zA-Z:0-9]+\\)[ \t]+\\([a-zA-Z]+\\)")
      (setq hotlist (cons (cons (match-string 1)
				(intern (match-string 2)))
			  hotlist))
      (forward-line 1))
    (if (not (looking-at "^[ \t]*$"))
	(error "Malformed entry in hotlist, discarding edits"))
    (setq eudc-server-hotlist (nreverse hotlist))
    (eudc-install-menu)
    (eudc-save-options)
    (kill-this-buffer)))

(defun eudc-hotlist-select-server ()
  "Select the server at point as the current server."
  (interactive)
  (if (not (eq major-mode 'eudc-hotlist-mode))
      (error "Not in a EUDC hotlist edit buffer"))
  (save-excursion
    (beginning-of-line)
    (if (and (>= (point) eudc-hotlist-list-beginning)
	     (looking-at "^\\([-.a-zA-Z:0-9]+\\)[ \t]+\\([a-zA-Z]+\\)"))
	(progn
	  (eudc-set-server (match-string 1) (intern (match-string 2)))
	  (message "Current directory server is %s (%s)" eudc-server eudc-protocol))
      (error "No server on this line"))))

(defun eudc-hotlist-transpose-servers ()
  "Swap the order of the server with the previous one in the list."
  (interactive)
  (if (not (eq major-mode 'eudc-hotlist-mode))
      (error "Not in a EUDC hotlist edit buffer"))
  (let ((buffer-read-only nil))
    (save-excursion
      (beginning-of-line)
      (if (and (>= (point) eudc-hotlist-list-beginning)
	       (looking-at "^\\([-.a-zA-Z:0-9]+\\)[ \t]+\\([a-zA-Z]+\\)")
	       (progn
		 (forward-line -1)
		 (looking-at "^\\([-.a-zA-Z:0-9]+\\)[ \t]+\\([a-zA-Z]+\\)")))
	  (progn
	    (forward-line 1)
	    (transpose-lines 1))))))

(setq eudc-hotlist-mode-map
      (let ((map (make-sparse-keymap)))
	(define-key map "a" 'eudc-hotlist-add-server)
	(define-key map "d" 'eudc-hotlist-delete-server)
	(define-key map "s" 'eudc-hotlist-select-server)
	(define-key map "t" 'eudc-hotlist-transpose-servers)
	(define-key map "q" 'eudc-hotlist-quit-edit)
	(define-key map "x" 'kill-this-buffer)
	map))

(defconst eudc-hotlist-menu
  '("EUDC Hotlist Edit"
    ["---" nil nil]
    ["Add New Server" eudc-hotlist-add-server t]
    ["Delete Server" eudc-hotlist-delete-server t]
    ["Select Server" eudc-hotlist-select-server t]
    ["Transpose Servers" eudc-hotlist-transpose-servers t]
    ["Save and Quit" eudc-hotlist-quit-edit t]
    ["Exit without Saving" kill-this-buffer t]))

(when (not (featurep 'xemacs))
  (easy-menu-define eudc-hotlist-emacs-menu
    eudc-hotlist-mode-map
    ""
    eudc-hotlist-menu))

;; arch-tag: 9b633ab3-6a6e-4b46-b12e-d96739a7e0e8
;;; eudc-hotlist.el ends here