Mercurial > emacs
annotate lisp/net/eudc-hotlist.el @ 87498:566965810b9e
*** empty log message ***
author | Magnus Henoch <mange@freemail.hu> |
---|---|
date | Mon, 31 Dec 2007 00:57:51 +0000 |
parents | f873840f9fea |
children | 107ccd98fa12 4bc33ffdda1a |
rev | line source |
---|---|
38422
7a94f1c588c4
Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents:
27313
diff
changeset
|
1 ;;; eudc-hotlist.el --- hotlist management for EUDC |
27313 | 2 |
74509 | 3 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, |
75347 | 4 ;; 2005, 2006, 2007 Free Software Foundation, Inc. |
27313 | 5 |
42778
6d743d659035
New maintainer. Change author's address.
Pavel Janík <Pavel@Janik.cz>
parents:
42574
diff
changeset
|
6 ;; Author: Oscar Figueiredo <oscar@cpe.fr> |
6d743d659035
New maintainer. Change author's address.
Pavel Janík <Pavel@Janik.cz>
parents:
42574
diff
changeset
|
7 ;; Maintainer: Pavel Janík <Pavel@Janik.cz> |
42574 | 8 ;; Keywords: comm |
27313 | 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 | |
78230
84cf1e2214c5
Switch license to GPLv3 or later.
Glenn Morris <rgm@gnu.org>
parents:
75347
diff
changeset
|
14 ;; the Free Software Foundation; either version 3, or (at your option) |
27313 | 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 | |
64085 | 24 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
25 ;; Boston, MA 02110-1301, USA. | |
27313 | 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 | |
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." | |
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) | |
64388
2b4cb2b750b1
(eudc-hotlist-mode): Avoid warnings.
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
55 (when (featurep 'xemacs) |
2b4cb2b750b1
(eudc-hotlist-mode): Avoid warnings.
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
56 (setq mode-popup-menu eudc-hotlist-menu) |
2b4cb2b750b1
(eudc-hotlist-mode): Avoid warnings.
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
57 (when (featurep 'menubar) |
2b4cb2b750b1
(eudc-hotlist-mode): Avoid warnings.
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
58 (set-buffer-menubar current-menubar) |
2b4cb2b750b1
(eudc-hotlist-mode): Avoid warnings.
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
59 (add-submenu nil (cons "EUDC-Hotlist" (cdr (cdr eudc-hotlist-menu)))))) |
63243
7aa95a2ceedc
(eudc-hotlist-mode): Use run-mode-hooks.
Lute Kamstra <lute@gnu.org>
parents:
52401
diff
changeset
|
60 (setq buffer-read-only t) |
7aa95a2ceedc
(eudc-hotlist-mode): Use run-mode-hooks.
Lute Kamstra <lute@gnu.org>
parents:
52401
diff
changeset
|
61 (run-mode-hooks 'eudc-hotlist-mode-hook)) |
27313 | 62 |
63 ;;;###autoload | |
64 (defun eudc-edit-hotlist () | |
65 "Edit the hotlist of directory servers in a specialized buffer." | |
66 (interactive) | |
42553
e34193f03ff3
(eudc-edit-hotlist): Avoid error when editing an empty hotlist.
Pavel Janík <Pavel@Janik.cz>
parents:
38422
diff
changeset
|
67 (let ((proto-col 10) |
27313 | 68 gap) |
69 (switch-to-buffer (get-buffer-create "*EUDC Servers*")) | |
70 (setq buffer-read-only nil) | |
71 (erase-buffer) | |
85230
e2575abf895a
(eudc-edit-hotlist): Use mapc rather than mapcar.
Glenn Morris <rgm@gnu.org>
parents:
78230
diff
changeset
|
72 (mapc (function |
e2575abf895a
(eudc-edit-hotlist): Use mapc rather than mapcar.
Glenn Morris <rgm@gnu.org>
parents:
78230
diff
changeset
|
73 (lambda (entry) |
e2575abf895a
(eudc-edit-hotlist): Use mapc rather than mapcar.
Glenn Morris <rgm@gnu.org>
parents:
78230
diff
changeset
|
74 (setq proto-col (max (length (car entry)) proto-col)))) |
e2575abf895a
(eudc-edit-hotlist): Use mapc rather than mapcar.
Glenn Morris <rgm@gnu.org>
parents:
78230
diff
changeset
|
75 eudc-server-hotlist) |
27313 | 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)) | |
85230
e2575abf895a
(eudc-edit-hotlist): Use mapc rather than mapcar.
Glenn Morris <rgm@gnu.org>
parents:
78230
diff
changeset
|
85 (mapc '(lambda (entry) |
27313 | 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) | |
42570
78a4068d960a
Remove unnecessary whitespaces.
Pavel Janík <Pavel@Janik.cz>
parents:
42553
diff
changeset
|
118 (if (and (>= (point) eudc-hotlist-list-beginning) |
27313 | 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]*$")) | |
42570
78a4068d960a
Remove unnecessary whitespaces.
Pavel Janík <Pavel@Janik.cz>
parents:
42553
diff
changeset
|
136 (error "Malformed entry in hotlist, discarding edits")) |
27313 | 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")))) | |
42570
78a4068d960a
Remove unnecessary whitespaces.
Pavel Janík <Pavel@Janik.cz>
parents:
42553
diff
changeset
|
155 |
27313 | 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]+\\)") | |
42570
78a4068d960a
Remove unnecessary whitespaces.
Pavel Janík <Pavel@Janik.cz>
parents:
42553
diff
changeset
|
166 (progn |
27313 | 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)))))) | |
42570
78a4068d960a
Remove unnecessary whitespaces.
Pavel Janík <Pavel@Janik.cz>
parents:
42553
diff
changeset
|
172 |
27313 | 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 | |
85511
f873840f9fea
* emulation/edt-mapper.el (function-key-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
85230
diff
changeset
|
193 (when (not (featurep 'xemacs)) |
f873840f9fea
* emulation/edt-mapper.el (function-key-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
85230
diff
changeset
|
194 (easy-menu-define eudc-hotlist-emacs-menu |
f873840f9fea
* emulation/edt-mapper.el (function-key-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
85230
diff
changeset
|
195 eudc-hotlist-mode-map |
f873840f9fea
* emulation/edt-mapper.el (function-key-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
85230
diff
changeset
|
196 "" |
f873840f9fea
* emulation/edt-mapper.el (function-key-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
85230
diff
changeset
|
197 eudc-hotlist-menu)) |
27313 | 198 |
52401 | 199 ;;; arch-tag: 9b633ab3-6a6e-4b46-b12e-d96739a7e0e8 |
27313 | 200 ;;; eudc-hotlist.el ends here |