Mercurial > emacs
annotate lisp/net/eudc-hotlist.el @ 112353:71904feb29f6
Improve performance on non-GCC hosts with __aligned__.
author | Paul Eggert <eggert@cs.ucla.edu> |
---|---|
date | Mon, 17 Jan 2011 20:55:12 -0800 |
parents | ef719132ddfa |
children |
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, |
112218
376148b31b5e
Add 2011 to FSF/AIST copyright years.
Glenn Morris <rgm@gnu.org>
parents:
106815
diff
changeset
|
4 ;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 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-list-beginning nil) | |
37 | |
110909
cc035ccb9275
Declare and define in one step various mode maps.
Dan Nicolaescu <dann@ics.uci.edu>
parents:
110015
diff
changeset
|
38 (defvar eudc-hotlist-mode-map |
cc035ccb9275
Declare and define in one step various mode maps.
Dan Nicolaescu <dann@ics.uci.edu>
parents:
110015
diff
changeset
|
39 (let ((map (make-sparse-keymap))) |
cc035ccb9275
Declare and define in one step various mode maps.
Dan Nicolaescu <dann@ics.uci.edu>
parents:
110015
diff
changeset
|
40 (define-key map "a" 'eudc-hotlist-add-server) |
cc035ccb9275
Declare and define in one step various mode maps.
Dan Nicolaescu <dann@ics.uci.edu>
parents:
110015
diff
changeset
|
41 (define-key map "d" 'eudc-hotlist-delete-server) |
cc035ccb9275
Declare and define in one step various mode maps.
Dan Nicolaescu <dann@ics.uci.edu>
parents:
110015
diff
changeset
|
42 (define-key map "s" 'eudc-hotlist-select-server) |
cc035ccb9275
Declare and define in one step various mode maps.
Dan Nicolaescu <dann@ics.uci.edu>
parents:
110015
diff
changeset
|
43 (define-key map "t" 'eudc-hotlist-transpose-servers) |
cc035ccb9275
Declare and define in one step various mode maps.
Dan Nicolaescu <dann@ics.uci.edu>
parents:
110015
diff
changeset
|
44 (define-key map "q" 'eudc-hotlist-quit-edit) |
cc035ccb9275
Declare and define in one step various mode maps.
Dan Nicolaescu <dann@ics.uci.edu>
parents:
110015
diff
changeset
|
45 (define-key map "x" 'kill-this-buffer) |
cc035ccb9275
Declare and define in one step various mode maps.
Dan Nicolaescu <dann@ics.uci.edu>
parents:
110015
diff
changeset
|
46 map)) |
cc035ccb9275
Declare and define in one step various mode maps.
Dan Nicolaescu <dann@ics.uci.edu>
parents:
110015
diff
changeset
|
47 |
27313 | 48 (defun eudc-hotlist-mode () |
49 "Major mode used to edit the hotlist of servers. | |
50 | |
51 These are the special commands of this mode: | |
52 a -- Add a new server to the list. | |
53 d -- Delete the server at point from the list. | |
54 s -- Select the server at point. | |
55 t -- Transpose the server at point and the previous one | |
56 q -- Commit the changes and quit. | |
57 x -- Quit without commiting the changes." | |
58 (interactive) | |
59 (kill-all-local-variables) | |
60 (setq major-mode 'eudc-hotlist-mode) | |
61 (setq mode-name "EUDC-Servers") | |
62 (use-local-map eudc-hotlist-mode-map) | |
64388
2b4cb2b750b1
(eudc-hotlist-mode): Avoid warnings.
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
63 (when (featurep 'xemacs) |
2b4cb2b750b1
(eudc-hotlist-mode): Avoid warnings.
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
64 (setq mode-popup-menu eudc-hotlist-menu) |
2b4cb2b750b1
(eudc-hotlist-mode): Avoid warnings.
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
65 (when (featurep 'menubar) |
2b4cb2b750b1
(eudc-hotlist-mode): Avoid warnings.
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
66 (set-buffer-menubar current-menubar) |
2b4cb2b750b1
(eudc-hotlist-mode): Avoid warnings.
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
67 (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
|
68 (setq buffer-read-only t) |
7aa95a2ceedc
(eudc-hotlist-mode): Use run-mode-hooks.
Lute Kamstra <lute@gnu.org>
parents:
52401
diff
changeset
|
69 (run-mode-hooks 'eudc-hotlist-mode-hook)) |
27313 | 70 |
71 ;;;###autoload | |
72 (defun eudc-edit-hotlist () | |
73 "Edit the hotlist of directory servers in a specialized buffer." | |
74 (interactive) | |
42553
e34193f03ff3
(eudc-edit-hotlist): Avoid error when editing an empty hotlist.
Pavel Janík <Pavel@Janik.cz>
parents:
38422
diff
changeset
|
75 (let ((proto-col 10) |
27313 | 76 gap) |
77 (switch-to-buffer (get-buffer-create "*EUDC Servers*")) | |
78 (setq buffer-read-only nil) | |
79 (erase-buffer) | |
85230
e2575abf895a
(eudc-edit-hotlist): Use mapc rather than mapcar.
Glenn Morris <rgm@gnu.org>
parents:
78230
diff
changeset
|
80 (mapc (function |
e2575abf895a
(eudc-edit-hotlist): Use mapc rather than mapcar.
Glenn Morris <rgm@gnu.org>
parents:
78230
diff
changeset
|
81 (lambda (entry) |
e2575abf895a
(eudc-edit-hotlist): Use mapc rather than mapcar.
Glenn Morris <rgm@gnu.org>
parents:
78230
diff
changeset
|
82 (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
|
83 eudc-server-hotlist) |
27313 | 84 (setq proto-col (+ 3 proto-col)) |
85 (setq gap (make-string (- proto-col 6) ?\ )) | |
86 (insert " EUDC Servers\n" | |
87 " ============\n" | |
88 "\n" | |
89 "Server" gap "Protocol\n" | |
90 "------" gap "--------\n" | |
91 "\n") | |
92 (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
|
93 (mapc '(lambda (entry) |
27313 | 94 (insert (car entry)) |
95 (indent-to proto-col) | |
96 (insert (symbol-name (cdr entry)) "\n")) | |
97 eudc-server-hotlist) | |
98 (eudc-hotlist-mode))) | |
99 | |
100 (defun eudc-hotlist-add-server () | |
101 "Add a new server to the list after current one." | |
102 (interactive) | |
103 (if (not (eq major-mode 'eudc-hotlist-mode)) | |
104 (error "Not in a EUDC hotlist edit buffer")) | |
105 (let ((server (read-from-minibuffer "Server: ")) | |
106 (protocol (completing-read "Protocol: " | |
107 (mapcar '(lambda (elt) | |
108 (cons (symbol-name elt) | |
109 elt)) | |
110 eudc-known-protocols))) | |
111 (buffer-read-only nil)) | |
112 (if (not (eobp)) | |
113 (forward-line 1)) | |
114 (insert server) | |
115 (indent-to 30) | |
116 (insert protocol "\n"))) | |
117 | |
118 (defun eudc-hotlist-delete-server () | |
119 "Delete the server at point from the list." | |
120 (interactive) | |
121 (if (not (eq major-mode 'eudc-hotlist-mode)) | |
122 (error "Not in a EUDC hotlist edit buffer")) | |
123 (let ((buffer-read-only nil)) | |
124 (save-excursion | |
125 (beginning-of-line) | |
42570
78a4068d960a
Remove unnecessary whitespaces.
Pavel Janík <Pavel@Janik.cz>
parents:
42553
diff
changeset
|
126 (if (and (>= (point) eudc-hotlist-list-beginning) |
27313 | 127 (looking-at "^\\([-.a-zA-Z:0-9]+\\)[ \t]+\\([a-zA-Z]+\\)")) |
128 (kill-line 1) | |
129 (error "No server on this line"))))) | |
130 | |
131 (defun eudc-hotlist-quit-edit () | |
132 "Quit the hotlist editing mode and save changes to the hotlist." | |
133 (interactive) | |
134 (if (not (eq major-mode 'eudc-hotlist-mode)) | |
135 (error "Not in a EUDC hotlist edit buffer")) | |
136 (let (hotlist) | |
137 (goto-char eudc-hotlist-list-beginning) | |
138 (while (looking-at "^\\([-.a-zA-Z:0-9]+\\)[ \t]+\\([a-zA-Z]+\\)") | |
139 (setq hotlist (cons (cons (match-string 1) | |
140 (intern (match-string 2))) | |
141 hotlist)) | |
142 (forward-line 1)) | |
143 (if (not (looking-at "^[ \t]*$")) | |
42570
78a4068d960a
Remove unnecessary whitespaces.
Pavel Janík <Pavel@Janik.cz>
parents:
42553
diff
changeset
|
144 (error "Malformed entry in hotlist, discarding edits")) |
27313 | 145 (setq eudc-server-hotlist (nreverse hotlist)) |
146 (eudc-install-menu) | |
147 (eudc-save-options) | |
148 (kill-this-buffer))) | |
149 | |
150 (defun eudc-hotlist-select-server () | |
151 "Select the server at point as the current server." | |
152 (interactive) | |
153 (if (not (eq major-mode 'eudc-hotlist-mode)) | |
154 (error "Not in a EUDC hotlist edit buffer")) | |
155 (save-excursion | |
156 (beginning-of-line) | |
157 (if (and (>= (point) eudc-hotlist-list-beginning) | |
158 (looking-at "^\\([-.a-zA-Z:0-9]+\\)[ \t]+\\([a-zA-Z]+\\)")) | |
159 (progn | |
160 (eudc-set-server (match-string 1) (intern (match-string 2))) | |
161 (message "Current directory server is %s (%s)" eudc-server eudc-protocol)) | |
162 (error "No server on this line")))) | |
42570
78a4068d960a
Remove unnecessary whitespaces.
Pavel Janík <Pavel@Janik.cz>
parents:
42553
diff
changeset
|
163 |
27313 | 164 (defun eudc-hotlist-transpose-servers () |
165 "Swap the order of the server with the previous one in the list." | |
166 (interactive) | |
167 (if (not (eq major-mode 'eudc-hotlist-mode)) | |
168 (error "Not in a EUDC hotlist edit buffer")) | |
169 (let ((buffer-read-only nil)) | |
170 (save-excursion | |
171 (beginning-of-line) | |
172 (if (and (>= (point) eudc-hotlist-list-beginning) | |
173 (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
|
174 (progn |
27313 | 175 (forward-line -1) |
176 (looking-at "^\\([-.a-zA-Z:0-9]+\\)[ \t]+\\([a-zA-Z]+\\)"))) | |
177 (progn | |
178 (forward-line 1) | |
179 (transpose-lines 1)))))) | |
42570
78a4068d960a
Remove unnecessary whitespaces.
Pavel Janík <Pavel@Janik.cz>
parents:
42553
diff
changeset
|
180 |
27313 | 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 |
197 ;;; eudc-hotlist.el ends here |