1 ;;; eudc-hotlist.el --- hotlist management for EUDC
3 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4 ;; 2005, 2006, 2007 Free Software Foundation, Inc.
6 ;; Author: Oscar Figueiredo <oscar@cpe.fr>
7 ;; Maintainer: Pavel JanÃk <Pavel@Janik.cz>
10 ;; This file is part of GNU Emacs.
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 3, or (at your option)
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.
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.
30 ;; See the corresponding info file
36 (defvar eudc-hotlist-menu nil)
37 (defvar eudc-hotlist-mode-map nil)
38 (defvar eudc-hotlist-list-beginning nil)
40 (defun eudc-hotlist-mode ()
41 "Major mode used to edit the hotlist of servers.
43 These 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."
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))
64 (defun eudc-edit-hotlist ()
65 "Edit the hotlist of directory servers in a specialized buffer."
69 (switch-to-buffer (get-buffer-create "*EUDC Servers*"))
70 (setq buffer-read-only nil)
74 (setq proto-col (max (length (car entry)) proto-col))))
76 (setq proto-col (+ 3 proto-col))
77 (setq gap (make-string (- proto-col 6) ?\ ))
78 (insert " EUDC Servers\n"
81 "Server" gap "Protocol\n"
82 "------" gap "--------\n"
84 (setq eudc-hotlist-list-beginning (point))
85 (mapcar '(lambda (entry)
88 (insert (symbol-name (cdr entry)) "\n"))
92 (defun eudc-hotlist-add-server ()
93 "Add a new server to the list after current one."
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)
102 eudc-known-protocols)))
103 (buffer-read-only nil))
108 (insert protocol "\n")))
110 (defun eudc-hotlist-delete-server ()
111 "Delete the server at point from the list."
113 (if (not (eq major-mode 'eudc-hotlist-mode))
114 (error "Not in a EUDC hotlist edit buffer"))
115 (let ((buffer-read-only nil))
118 (if (and (>= (point) eudc-hotlist-list-beginning)
119 (looking-at "^\\([-.a-zA-Z:0-9]+\\)[ \t]+\\([a-zA-Z]+\\)"))
121 (error "No server on this line")))))
123 (defun eudc-hotlist-quit-edit ()
124 "Quit the hotlist editing mode and save changes to the hotlist."
126 (if (not (eq major-mode 'eudc-hotlist-mode))
127 (error "Not in a EUDC hotlist edit buffer"))
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)))
135 (if (not (looking-at "^[ \t]*$"))
136 (error "Malformed entry in hotlist, discarding edits"))
137 (setq eudc-server-hotlist (nreverse hotlist))
142 (defun eudc-hotlist-select-server ()
143 "Select the server at point as the current server."
145 (if (not (eq major-mode 'eudc-hotlist-mode))
146 (error "Not in a EUDC hotlist edit buffer"))
149 (if (and (>= (point) eudc-hotlist-list-beginning)
150 (looking-at "^\\([-.a-zA-Z:0-9]+\\)[ \t]+\\([a-zA-Z]+\\)"))
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"))))
156 (defun eudc-hotlist-transpose-servers ()
157 "Swap the order of the server with the previous one in the list."
159 (if (not (eq major-mode 'eudc-hotlist-mode))
160 (error "Not in a EUDC hotlist edit buffer"))
161 (let ((buffer-read-only nil))
164 (if (and (>= (point) eudc-hotlist-list-beginning)
165 (looking-at "^\\([-.a-zA-Z:0-9]+\\)[ \t]+\\([a-zA-Z]+\\)")
168 (looking-at "^\\([-.a-zA-Z:0-9]+\\)[ \t]+\\([a-zA-Z]+\\)")))
171 (transpose-lines 1))))))
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)
183 (defconst eudc-hotlist-menu
184 '("EUDC Hotlist Edit"
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]))
194 (easy-menu-define eudc-hotlist-emacs-menu
195 eudc-hotlist-mode-map
199 ;;; arch-tag: 9b633ab3-6a6e-4b46-b12e-d96739a7e0e8
200 ;;; eudc-hotlist.el ends here