1 ;;; eudc-hotlist.el --- hotlist management for EUDC
3 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4 ;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
6 ;; Author: Oscar Figueiredo <oscar@cpe.fr>
7 ;; Maintainer: Pavel JanÃk <Pavel@Janik.cz>
11 ;; This file is part of GNU Emacs.
13 ;; GNU Emacs is free software: you can redistribute it and/or modify
14 ;; it under the terms of the GNU General Public License as published by
15 ;; the Free Software Foundation, either version 3 of the License, or
16 ;; (at your option) any later version.
18 ;; GNU Emacs is distributed in the hope that it will be useful,
19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 ;; GNU General Public License for more details.
23 ;; You should have received a copy of the GNU General Public License
24 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
29 ;; See the corresponding info file
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."
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 (when (featurep 'xemacs
)
55 (setq mode-popup-menu eudc-hotlist-menu
)
56 (when (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
)
60 (run-mode-hooks 'eudc-hotlist-mode-hook
))
63 (defun eudc-edit-hotlist ()
64 "Edit the hotlist of directory servers in a specialized buffer."
68 (switch-to-buffer (get-buffer-create "*EUDC Servers*"))
69 (setq buffer-read-only nil
)
73 (setq proto-col
(max (length (car entry
)) proto-col
))))
75 (setq proto-col
(+ 3 proto-col
))
76 (setq gap
(make-string (- proto-col
6) ?\
))
77 (insert " EUDC Servers\n"
80 "Server" gap
"Protocol\n"
81 "------" gap
"--------\n"
83 (setq eudc-hotlist-list-beginning
(point))
84 (mapc '(lambda (entry)
87 (insert (symbol-name (cdr entry
)) "\n"))
91 (defun eudc-hotlist-add-server ()
92 "Add a new server to the list after current one."
94 (if (not (eq major-mode
'eudc-hotlist-mode
))
95 (error "Not in a EUDC hotlist edit buffer"))
96 (let ((server (read-from-minibuffer "Server: "))
97 (protocol (completing-read "Protocol: "
98 (mapcar '(lambda (elt)
99 (cons (symbol-name elt
)
101 eudc-known-protocols
)))
102 (buffer-read-only nil
))
107 (insert protocol
"\n")))
109 (defun eudc-hotlist-delete-server ()
110 "Delete the server at point from the list."
112 (if (not (eq major-mode
'eudc-hotlist-mode
))
113 (error "Not in a EUDC hotlist edit buffer"))
114 (let ((buffer-read-only nil
))
117 (if (and (>= (point) eudc-hotlist-list-beginning
)
118 (looking-at "^\\([-.a-zA-Z:0-9]+\\)[ \t]+\\([a-zA-Z]+\\)"))
120 (error "No server on this line")))))
122 (defun eudc-hotlist-quit-edit ()
123 "Quit the hotlist editing mode and save changes to the hotlist."
125 (if (not (eq major-mode
'eudc-hotlist-mode
))
126 (error "Not in a EUDC hotlist edit buffer"))
128 (goto-char eudc-hotlist-list-beginning
)
129 (while (looking-at "^\\([-.a-zA-Z:0-9]+\\)[ \t]+\\([a-zA-Z]+\\)")
130 (setq hotlist
(cons (cons (match-string 1)
131 (intern (match-string 2)))
134 (if (not (looking-at "^[ \t]*$"))
135 (error "Malformed entry in hotlist, discarding edits"))
136 (setq eudc-server-hotlist
(nreverse hotlist
))
141 (defun eudc-hotlist-select-server ()
142 "Select the server at point as the current server."
144 (if (not (eq major-mode
'eudc-hotlist-mode
))
145 (error "Not in a EUDC hotlist edit buffer"))
148 (if (and (>= (point) eudc-hotlist-list-beginning
)
149 (looking-at "^\\([-.a-zA-Z:0-9]+\\)[ \t]+\\([a-zA-Z]+\\)"))
151 (eudc-set-server (match-string 1) (intern (match-string 2)))
152 (message "Current directory server is %s (%s)" eudc-server eudc-protocol
))
153 (error "No server on this line"))))
155 (defun eudc-hotlist-transpose-servers ()
156 "Swap the order of the server with the previous one in the list."
158 (if (not (eq major-mode
'eudc-hotlist-mode
))
159 (error "Not in a EUDC hotlist edit buffer"))
160 (let ((buffer-read-only nil
))
163 (if (and (>= (point) eudc-hotlist-list-beginning
)
164 (looking-at "^\\([-.a-zA-Z:0-9]+\\)[ \t]+\\([a-zA-Z]+\\)")
167 (looking-at "^\\([-.a-zA-Z:0-9]+\\)[ \t]+\\([a-zA-Z]+\\)")))
170 (transpose-lines 1))))))
172 (setq eudc-hotlist-mode-map
173 (let ((map (make-sparse-keymap)))
174 (define-key map
"a" 'eudc-hotlist-add-server
)
175 (define-key map
"d" 'eudc-hotlist-delete-server
)
176 (define-key map
"s" 'eudc-hotlist-select-server
)
177 (define-key map
"t" 'eudc-hotlist-transpose-servers
)
178 (define-key map
"q" 'eudc-hotlist-quit-edit
)
179 (define-key map
"x" 'kill-this-buffer
)
182 (defconst eudc-hotlist-menu
183 '("EUDC Hotlist Edit"
185 ["Add New Server" eudc-hotlist-add-server t
]
186 ["Delete Server" eudc-hotlist-delete-server t
]
187 ["Select Server" eudc-hotlist-select-server t
]
188 ["Transpose Servers" eudc-hotlist-transpose-servers t
]
189 ["Save and Quit" eudc-hotlist-quit-edit t
]
190 ["Exit without Saving" kill-this-buffer t
]))
192 (when (not (featurep 'xemacs
))
193 (easy-menu-define eudc-hotlist-emacs-menu
194 eudc-hotlist-mode-map
198 ;; arch-tag: 9b633ab3-6a6e-4b46-b12e-d96739a7e0e8
199 ;;; eudc-hotlist.el ends here