Mercurial > emacs
annotate lisp/net/eudc-hotlist.el @ 110682:ba6a1c230532
gnus-html.el (gnus-html-prefetch-images): Adjust regexp to avoid regexp backtrace overflows.
author | Katsumi Yamaoka <yamaoka@jpl.org> |
---|---|
date | Fri, 01 Oct 2010 13:33:03 +0000 |
parents | 280c8ae2476d |
children | cc035ccb9275 |
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, |
106815 | 4 ;; 2005, 2006, 2007, 2008, 2009, 2010 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 |
110015
280c8ae2476d
Add "Package:" file headers to denote built-in packages.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
9 ;; Package: eudc |
27313 | 10 |
11 ;; This file is part of GNU Emacs. | |
12 | |
94677
91e5880a36c1
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
13 ;; GNU Emacs is free software: you can redistribute it and/or modify |
27313 | 14 ;; 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
|
15 ;; 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
|
16 ;; (at your option) any later version. |
27313 | 17 |
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. | |
22 | |
23 ;; 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
|
24 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
27313 | 25 |
26 ;;; Commentary: | |
27 | |
28 ;;; Usage: | |
29 ;; See the corresponding info file | |
30 | |
31 ;;; Code: | |
32 | |
33 (require 'eudc) | |
34 | |
35 (defvar eudc-hotlist-menu nil) | |
36 (defvar eudc-hotlist-mode-map nil) | |
37 (defvar eudc-hotlist-list-beginning nil) | |
38 | |
39 (defun eudc-hotlist-mode () | |
40 "Major mode used to edit the hotlist of servers. | |
41 | |
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) | |
64388
2b4cb2b750b1
(eudc-hotlist-mode): Avoid warnings.
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
54 (when (featurep 'xemacs) |
2b4cb2b750b1
(eudc-hotlist-mode): Avoid warnings.
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
55 (setq mode-popup-menu eudc-hotlist-menu) |
2b4cb2b750b1
(eudc-hotlist-mode): Avoid warnings.
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
56 (when (featurep 'menubar) |
2b4cb2b750b1
(eudc-hotlist-mode): Avoid warnings.
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
57 (set-buffer-menubar current-menubar) |
2b4cb2b750b1
(eudc-hotlist-mode): Avoid warnings.
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
58 (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
|
59 (setq buffer-read-only t) |
7aa95a2ceedc
(eudc-hotlist-mode): Use run-mode-hooks.
Lute Kamstra <lute@gnu.org>
parents:
52401
diff
changeset
|
60 (run-mode-hooks 'eudc-hotlist-mode-hook)) |
27313 | 61 |
62 ;;;###autoload | |
63 (defun eudc-edit-hotlist () | |
64 "Edit the hotlist of directory servers in a specialized buffer." | |
65 (interactive) | |
42553
e34193f03ff3
(eudc-edit-hotlist): Avoid error when editing an empty hotlist.
Pavel Janík <Pavel@Janik.cz>
parents:
38422
diff
changeset
|
66 (let ((proto-col 10) |
27313 | 67 gap) |
68 (switch-to-buffer (get-buffer-create "*EUDC Servers*")) | |
69 (setq buffer-read-only nil) | |
70 (erase-buffer) | |
85230
e2575abf895a
(eudc-edit-hotlist): Use mapc rather than mapcar.
Glenn Morris <rgm@gnu.org>
parents:
78230
diff
changeset
|
71 (mapc (function |
e2575abf895a
(eudc-edit-hotlist): Use mapc rather than mapcar.
Glenn Morris <rgm@gnu.org>
parents:
78230
diff
changeset
|
72 (lambda (entry) |
e2575abf895a
(eudc-edit-hotlist): Use mapc rather than mapcar.
Glenn Morris <rgm@gnu.org>
parents:
78230
diff
changeset
|
73 (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
|
74 eudc-server-hotlist) |
27313 | 75 (setq proto-col (+ 3 proto-col)) |
76 (setq gap (make-string (- proto-col 6) ?\ )) | |
77 (insert " EUDC Servers\n" | |
78 " ============\n" | |
79 "\n" | |
80 "Server" gap "Protocol\n" | |
81 "------" gap "--------\n" | |
82 "\n") | |
83 (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
|
84 (mapc '(lambda (entry) |
27313 | 85 (insert (car entry)) |
86 (indent-to proto-col) | |
87 (insert (symbol-name (cdr entry)) "\n")) | |
88 eudc-server-hotlist) | |
89 (eudc-hotlist-mode))) | |
90 | |
91 (defun eudc-hotlist-add-server () | |
92 "Add a new server to the list after current one." | |
93 (interactive) | |
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) | |
100 elt)) | |
101 eudc-known-protocols))) | |
102 (buffer-read-only nil)) | |
103 (if (not (eobp)) | |
104 (forward-line 1)) | |
105 (insert server) | |
106 (indent-to 30) | |
107 (insert protocol "\n"))) | |
108 | |
109 (defun eudc-hotlist-delete-server () | |
110 "Delete the server at point from the list." | |
111 (interactive) | |
112 (if (not (eq major-mode 'eudc-hotlist-mode)) | |
113 (error "Not in a EUDC hotlist edit buffer")) | |
114 (let ((buffer-read-only nil)) | |
115 (save-excursion | |
116 (beginning-of-line) | |
42570
78a4068d960a
Remove unnecessary whitespaces.
Pavel Janík <Pavel@Janik.cz>
parents:
42553
diff
changeset
|
117 (if (and (>= (point) eudc-hotlist-list-beginning) |
27313 | 118 (looking-at "^\\([-.a-zA-Z:0-9]+\\)[ \t]+\\([a-zA-Z]+\\)")) |
119 (kill-line 1) | |
120 (error "No server on this line"))))) | |
121 | |
122 (defun eudc-hotlist-quit-edit () | |
123 "Quit the hotlist editing mode and save changes to the hotlist." | |
124 (interactive) | |
125 (if (not (eq major-mode 'eudc-hotlist-mode)) | |
126 (error "Not in a EUDC hotlist edit buffer")) | |
127 (let (hotlist) | |
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))) | |
132 hotlist)) | |
133 (forward-line 1)) | |
134 (if (not (looking-at "^[ \t]*$")) | |
42570
78a4068d960a
Remove unnecessary whitespaces.
Pavel Janík <Pavel@Janik.cz>
parents:
42553
diff
changeset
|
135 (error "Malformed entry in hotlist, discarding edits")) |
27313 | 136 (setq eudc-server-hotlist (nreverse hotlist)) |
137 (eudc-install-menu) | |
138 (eudc-save-options) | |
139 (kill-this-buffer))) | |
140 | |
141 (defun eudc-hotlist-select-server () | |
142 "Select the server at point as the current server." | |
143 (interactive) | |
144 (if (not (eq major-mode 'eudc-hotlist-mode)) | |
145 (error "Not in a EUDC hotlist edit buffer")) | |
146 (save-excursion | |
147 (beginning-of-line) | |
148 (if (and (>= (point) eudc-hotlist-list-beginning) | |
149 (looking-at "^\\([-.a-zA-Z:0-9]+\\)[ \t]+\\([a-zA-Z]+\\)")) | |
150 (progn | |
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")))) | |
42570
78a4068d960a
Remove unnecessary whitespaces.
Pavel Janík <Pavel@Janik.cz>
parents:
42553
diff
changeset
|
154 |
27313 | 155 (defun eudc-hotlist-transpose-servers () |
156 "Swap the order of the server with the previous one in the list." | |
157 (interactive) | |
158 (if (not (eq major-mode 'eudc-hotlist-mode)) | |
159 (error "Not in a EUDC hotlist edit buffer")) | |
160 (let ((buffer-read-only nil)) | |
161 (save-excursion | |
162 (beginning-of-line) | |
163 (if (and (>= (point) eudc-hotlist-list-beginning) | |
164 (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
|
165 (progn |
27313 | 166 (forward-line -1) |
167 (looking-at "^\\([-.a-zA-Z:0-9]+\\)[ \t]+\\([a-zA-Z]+\\)"))) | |
168 (progn | |
169 (forward-line 1) | |
170 (transpose-lines 1)))))) | |
42570
78a4068d960a
Remove unnecessary whitespaces.
Pavel Janík <Pavel@Janik.cz>
parents:
42553
diff
changeset
|
171 |
27313 | 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) | |
180 map)) | |
181 | |
182 (defconst eudc-hotlist-menu | |
183 '("EUDC Hotlist Edit" | |
184 ["---" nil nil] | |
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])) | |
191 | |
85511
f873840f9fea
* emulation/edt-mapper.el (function-key-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
85230
diff
changeset
|
192 (when (not (featurep 'xemacs)) |
f873840f9fea
* emulation/edt-mapper.el (function-key-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
85230
diff
changeset
|
193 (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
|
194 eudc-hotlist-mode-map |
f873840f9fea
* emulation/edt-mapper.el (function-key-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
85230
diff
changeset
|
195 "" |
f873840f9fea
* emulation/edt-mapper.el (function-key-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
85230
diff
changeset
|
196 eudc-hotlist-menu)) |
27313 | 197 |
93975
1e3a407766b9
Fix up comment convention on the arch-tag lines.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
87649
diff
changeset
|
198 ;; arch-tag: 9b633ab3-6a6e-4b46-b12e-d96739a7e0e8 |
27313 | 199 ;;; eudc-hotlist.el ends here |