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