Mercurial > emacs
annotate lisp/net/eudc-hotlist.el @ 97800:0d162f4e0e6b
*** empty log message ***
author | Michael Albinus <michael.albinus@gmx.de> |
---|---|
date | Thu, 28 Aug 2008 20:31:35 +0000 |
parents | 91e5880a36c1 |
children | a9dc0e7c3f2b |
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, |
79714 | 4 ;; 2005, 2006, 2007, 2008 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 | |
94677
91e5880a36c1
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
12 ;; GNU Emacs is free software: you can redistribute it and/or modify |
27313 | 13 ;; it under the terms of the GNU General Public License as published by |
94677
91e5880a36c1
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
14 ;; the Free Software Foundation, either version 3 of the License, or |
91e5880a36c1
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
15 ;; (at your option) any later version. |
27313 | 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 | |
94677
91e5880a36c1
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
23 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
27313 | 24 |
25 ;;; Commentary: | |
26 | |
27 ;;; Usage: | |
28 ;; See the corresponding info file | |
29 | |
30 ;;; Code: | |
31 | |
32 (require 'eudc) | |
33 | |
34 (defvar eudc-hotlist-menu nil) | |
35 (defvar eudc-hotlist-mode-map nil) | |
36 (defvar eudc-hotlist-list-beginning nil) | |
37 | |
38 (defun eudc-hotlist-mode () | |
39 "Major mode used to edit the hotlist of servers. | |
40 | |
41 These are the special commands of this mode: | |
42 a -- Add a new server to the list. | |
43 d -- Delete the server at point from the list. | |
44 s -- Select the server at point. | |
45 t -- Transpose the server at point and the previous one | |
46 q -- Commit the changes and quit. | |
47 x -- Quit without commiting the changes." | |
48 (interactive) | |
49 (kill-all-local-variables) | |
50 (setq major-mode 'eudc-hotlist-mode) | |
51 (setq mode-name "EUDC-Servers") | |
52 (use-local-map eudc-hotlist-mode-map) | |
64388
2b4cb2b750b1
(eudc-hotlist-mode): Avoid warnings.
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
53 (when (featurep 'xemacs) |
2b4cb2b750b1
(eudc-hotlist-mode): Avoid warnings.
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
54 (setq mode-popup-menu eudc-hotlist-menu) |
2b4cb2b750b1
(eudc-hotlist-mode): Avoid warnings.
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
55 (when (featurep 'menubar) |
2b4cb2b750b1
(eudc-hotlist-mode): Avoid warnings.
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
56 (set-buffer-menubar current-menubar) |
2b4cb2b750b1
(eudc-hotlist-mode): Avoid warnings.
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
57 (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
|
58 (setq buffer-read-only t) |
7aa95a2ceedc
(eudc-hotlist-mode): Use run-mode-hooks.
Lute Kamstra <lute@gnu.org>
parents:
52401
diff
changeset
|
59 (run-mode-hooks 'eudc-hotlist-mode-hook)) |
27313 | 60 |
61 ;;;###autoload | |
62 (defun eudc-edit-hotlist () | |
63 "Edit the hotlist of directory servers in a specialized buffer." | |
64 (interactive) | |
42553
e34193f03ff3
(eudc-edit-hotlist): Avoid error when editing an empty hotlist.
Pavel Janík <Pavel@Janik.cz>
parents:
38422
diff
changeset
|
65 (let ((proto-col 10) |
27313 | 66 gap) |
67 (switch-to-buffer (get-buffer-create "*EUDC Servers*")) | |
68 (setq buffer-read-only nil) | |
69 (erase-buffer) | |
85230
e2575abf895a
(eudc-edit-hotlist): Use mapc rather than mapcar.
Glenn Morris <rgm@gnu.org>
parents:
78230
diff
changeset
|
70 (mapc (function |
e2575abf895a
(eudc-edit-hotlist): Use mapc rather than mapcar.
Glenn Morris <rgm@gnu.org>
parents:
78230
diff
changeset
|
71 (lambda (entry) |
e2575abf895a
(eudc-edit-hotlist): Use mapc rather than mapcar.
Glenn Morris <rgm@gnu.org>
parents:
78230
diff
changeset
|
72 (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
|
73 eudc-server-hotlist) |
27313 | 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)) | |
85230
e2575abf895a
(eudc-edit-hotlist): Use mapc rather than mapcar.
Glenn Morris <rgm@gnu.org>
parents:
78230
diff
changeset
|
83 (mapc '(lambda (entry) |
27313 | 84 (insert (car entry)) |
85 (indent-to proto-col) | |
86 (insert (symbol-name (cdr entry)) "\n")) | |
87 eudc-server-hotlist) | |
88 (eudc-hotlist-mode))) | |
89 | |
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"))) | |
107 | |
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) | |
42570
78a4068d960a
Remove unnecessary whitespaces.
Pavel Janík <Pavel@Janik.cz>
parents:
42553
diff
changeset
|
116 (if (and (>= (point) eudc-hotlist-list-beginning) |
27313 | 117 (looking-at "^\\([-.a-zA-Z:0-9]+\\)[ \t]+\\([a-zA-Z]+\\)")) |
118 (kill-line 1) | |
119 (error "No server on this line"))))) | |
120 | |
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]*$")) | |
42570
78a4068d960a
Remove unnecessary whitespaces.
Pavel Janík <Pavel@Janik.cz>
parents:
42553
diff
changeset
|
134 (error "Malformed entry in hotlist, discarding edits")) |
27313 | 135 (setq eudc-server-hotlist (nreverse hotlist)) |
136 (eudc-install-menu) | |
137 (eudc-save-options) | |
138 (kill-this-buffer))) | |
139 | |
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")))) | |
42570
78a4068d960a
Remove unnecessary whitespaces.
Pavel Janík <Pavel@Janik.cz>
parents:
42553
diff
changeset
|
153 |
27313 | 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]+\\)") | |
42570
78a4068d960a
Remove unnecessary whitespaces.
Pavel Janík <Pavel@Janik.cz>
parents:
42553
diff
changeset
|
164 (progn |
27313 | 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)))))) | |
42570
78a4068d960a
Remove unnecessary whitespaces.
Pavel Janík <Pavel@Janik.cz>
parents:
42553
diff
changeset
|
170 |
27313 | 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)) | |
180 | |
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])) | |
190 | |
85511
f873840f9fea
* emulation/edt-mapper.el (function-key-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
85230
diff
changeset
|
191 (when (not (featurep 'xemacs)) |
f873840f9fea
* emulation/edt-mapper.el (function-key-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
85230
diff
changeset
|
192 (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
|
193 eudc-hotlist-mode-map |
f873840f9fea
* emulation/edt-mapper.el (function-key-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
85230
diff
changeset
|
194 "" |
f873840f9fea
* emulation/edt-mapper.el (function-key-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
85230
diff
changeset
|
195 eudc-hotlist-menu)) |
27313 | 196 |
93975
1e3a407766b9
Fix up comment convention on the arch-tag lines.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
87649
diff
changeset
|
197 ;; arch-tag: 9b633ab3-6a6e-4b46-b12e-d96739a7e0e8 |
27313 | 198 ;;; eudc-hotlist.el ends here |