1;;; eudc-hotlist.el --- hotlist management for EUDC
2
3;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4;;   2005, 2006, 2007 Free Software Foundation, Inc.
5
6;; Author: Oscar Figueiredo <oscar@cpe.fr>
7;; Maintainer: Pavel Jan�k <Pavel@Janik.cz>
8;; Keywords: comm
9
10;; This file is part of GNU Emacs.
11
12;; GNU Emacs is free software; you can redistribute it and/or modify
13;; it under the terms of the GNU General Public License as published by
14;; the Free Software Foundation; either version 2, or (at your option)
15;; any later version.
16
17;; GNU Emacs is distributed in the hope that it will be useful,
18;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
20;; GNU General Public License for more details.
21
22;; You should have received a copy of the GNU General Public License
23;; along with GNU Emacs; see the file COPYING.  If not, write to the
24;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
25;; Boston, MA 02110-1301, USA.
26
27;;; Commentary:
28
29;;; Usage:
30;;    See the corresponding info file
31
32;;; Code:
33
34(require 'eudc)
35
36(defvar eudc-hotlist-menu nil)
37(defvar eudc-hotlist-mode-map nil)
38(defvar eudc-hotlist-list-beginning nil)
39
40(defun eudc-hotlist-mode ()
41  "Major mode used to edit the hotlist of servers.
42
43These are the special commands of this mode:
44    a -- Add a new server to the list.
45    d -- Delete the server at point from the list.
46    s -- Select the server at point.
47    t -- Transpose the server at point and the previous one
48    q -- Commit the changes and quit.
49    x -- Quit without commiting the changes."
50  (interactive)
51  (kill-all-local-variables)
52  (setq major-mode 'eudc-hotlist-mode)
53  (setq mode-name "EUDC-Servers")
54  (use-local-map eudc-hotlist-mode-map)
55  (when (featurep 'xemacs)
56    (setq mode-popup-menu eudc-hotlist-menu)
57    (when (featurep 'menubar)
58      (set-buffer-menubar current-menubar)
59      (add-submenu nil (cons "EUDC-Hotlist" (cdr (cdr eudc-hotlist-menu))))))
60  (setq buffer-read-only t)
61  (run-mode-hooks 'eudc-hotlist-mode-hook))
62
63;;;###autoload
64(defun eudc-edit-hotlist ()
65  "Edit the hotlist of directory servers in a specialized buffer."
66  (interactive)
67  (let ((proto-col 10)
68	gap)
69    (switch-to-buffer (get-buffer-create "*EUDC Servers*"))
70    (setq buffer-read-only nil)
71    (erase-buffer)
72    (mapcar (function
73	     (lambda (entry)
74	       (setq proto-col (max (length (car entry)) proto-col))))
75	    eudc-server-hotlist)
76    (setq proto-col (+ 3 proto-col))
77    (setq gap (make-string (- proto-col 6) ?\ ))
78    (insert "              EUDC Servers\n"
79	    "              ============\n"
80	    "\n"
81	    "Server" gap "Protocol\n"
82	    "------" gap "--------\n"
83	    "\n")
84    (setq eudc-hotlist-list-beginning (point))
85    (mapcar '(lambda (entry)
86	     (insert (car entry))
87	     (indent-to proto-col)
88	     (insert (symbol-name (cdr entry)) "\n"))
89	  eudc-server-hotlist)
90  (eudc-hotlist-mode)))
91
92(defun eudc-hotlist-add-server ()
93  "Add a new server to the list after current one."
94  (interactive)
95  (if (not (eq major-mode 'eudc-hotlist-mode))
96      (error "Not in a EUDC hotlist edit buffer"))
97  (let ((server (read-from-minibuffer "Server: "))
98	(protocol (completing-read "Protocol: "
99				   (mapcar '(lambda (elt)
100					      (cons (symbol-name elt)
101						    elt))
102					   eudc-known-protocols)))
103	(buffer-read-only nil))
104    (if (not (eobp))
105	(forward-line 1))
106    (insert server)
107    (indent-to 30)
108    (insert protocol "\n")))
109
110(defun eudc-hotlist-delete-server ()
111  "Delete the server at point from the list."
112  (interactive)
113  (if (not (eq major-mode 'eudc-hotlist-mode))
114      (error "Not in a EUDC hotlist edit buffer"))
115  (let ((buffer-read-only nil))
116    (save-excursion
117      (beginning-of-line)
118      (if (and (>= (point) eudc-hotlist-list-beginning)
119	       (looking-at "^\\([-.a-zA-Z:0-9]+\\)[ \t]+\\([a-zA-Z]+\\)"))
120	  (kill-line 1)
121	(error "No server on this line")))))
122
123(defun eudc-hotlist-quit-edit ()
124  "Quit the hotlist editing mode and save changes to the hotlist."
125  (interactive)
126  (if (not (eq major-mode 'eudc-hotlist-mode))
127      (error "Not in a EUDC hotlist edit buffer"))
128  (let (hotlist)
129    (goto-char eudc-hotlist-list-beginning)
130    (while (looking-at "^\\([-.a-zA-Z:0-9]+\\)[ \t]+\\([a-zA-Z]+\\)")
131      (setq hotlist (cons (cons (match-string 1)
132				(intern (match-string 2)))
133			  hotlist))
134      (forward-line 1))
135    (if (not (looking-at "^[ \t]*$"))
136	(error "Malformed entry in hotlist, discarding edits"))
137    (setq eudc-server-hotlist (nreverse hotlist))
138    (eudc-install-menu)
139    (eudc-save-options)
140    (kill-this-buffer)))
141
142(defun eudc-hotlist-select-server ()
143  "Select the server at point as the current server."
144  (interactive)
145  (if (not (eq major-mode 'eudc-hotlist-mode))
146      (error "Not in a EUDC hotlist edit buffer"))
147  (save-excursion
148    (beginning-of-line)
149    (if (and (>= (point) eudc-hotlist-list-beginning)
150	     (looking-at "^\\([-.a-zA-Z:0-9]+\\)[ \t]+\\([a-zA-Z]+\\)"))
151	(progn
152	  (eudc-set-server (match-string 1) (intern (match-string 2)))
153	  (message "Current directory server is %s (%s)" eudc-server eudc-protocol))
154      (error "No server on this line"))))
155
156(defun eudc-hotlist-transpose-servers ()
157  "Swap the order of the server with the previous one in the list."
158  (interactive)
159  (if (not (eq major-mode 'eudc-hotlist-mode))
160      (error "Not in a EUDC hotlist edit buffer"))
161  (let ((buffer-read-only nil))
162    (save-excursion
163      (beginning-of-line)
164      (if (and (>= (point) eudc-hotlist-list-beginning)
165	       (looking-at "^\\([-.a-zA-Z:0-9]+\\)[ \t]+\\([a-zA-Z]+\\)")
166	       (progn
167		 (forward-line -1)
168		 (looking-at "^\\([-.a-zA-Z:0-9]+\\)[ \t]+\\([a-zA-Z]+\\)")))
169	  (progn
170	    (forward-line 1)
171	    (transpose-lines 1))))))
172
173(setq eudc-hotlist-mode-map
174      (let ((map (make-sparse-keymap)))
175	(define-key map "a" 'eudc-hotlist-add-server)
176	(define-key map "d" 'eudc-hotlist-delete-server)
177	(define-key map "s" 'eudc-hotlist-select-server)
178	(define-key map "t" 'eudc-hotlist-transpose-servers)
179	(define-key map "q" 'eudc-hotlist-quit-edit)
180	(define-key map "x" 'kill-this-buffer)
181	map))
182
183(defconst eudc-hotlist-menu
184  '("EUDC Hotlist Edit"
185    ["---" nil nil]
186    ["Add New Server" eudc-hotlist-add-server t]
187    ["Delete Server" eudc-hotlist-delete-server t]
188    ["Select Server" eudc-hotlist-select-server t]
189    ["Transpose Servers" eudc-hotlist-transpose-servers t]
190    ["Save and Quit" eudc-hotlist-quit-edit t]
191    ["Exit without Saving" kill-this-buffer t]))
192
193(if eudc-emacs-p
194    (easy-menu-define eudc-hotlist-emacs-menu
195		      eudc-hotlist-mode-map
196		      ""
197		      eudc-hotlist-menu))
198
199;;; arch-tag: 9b633ab3-6a6e-4b46-b12e-d96739a7e0e8
200;;; eudc-hotlist.el ends here
201