1;;; eudc-hotlist.el --- hotlist management for EUDC 2 3;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 4;; 2005, 2006, 2007 Free Software Foundation, Inc. 5 6;; Author: Oscar Figueiredo <oscar@cpe.fr> 7;; Maintainer: Pavel Jan�k <Pavel@Janik.cz> 8;; Keywords: comm 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 14;; the Free Software Foundation; either version 2, or (at your option) 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 24;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 25;; Boston, MA 02110-1301, USA. 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 43These 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) 55 (when (featurep 'xemacs) 56 (setq mode-popup-menu eudc-hotlist-menu) 57 (when (featurep 'menubar) 58 (set-buffer-menubar current-menubar) 59 (add-submenu nil (cons "EUDC-Hotlist" (cdr (cdr eudc-hotlist-menu)))))) 60 (setq buffer-read-only t) 61 (run-mode-hooks 'eudc-hotlist-mode-hook)) 62 63;;;###autoload 64(defun eudc-edit-hotlist () 65 "Edit the hotlist of directory servers in a specialized buffer." 66 (interactive) 67 (let ((proto-col 10) 68 gap) 69 (switch-to-buffer (get-buffer-create "*EUDC Servers*")) 70 (setq buffer-read-only nil) 71 (erase-buffer) 72 (mapcar (function 73 (lambda (entry) 74 (setq proto-col (max (length (car entry)) proto-col)))) 75 eudc-server-hotlist) 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)) 85 (mapcar '(lambda (entry) 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) 118 (if (and (>= (point) eudc-hotlist-list-beginning) 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]*$")) 136 (error "Malformed entry in hotlist, discarding edits")) 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")))) 155 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]+\\)") 166 (progn 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)))))) 172 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 193(if eudc-emacs-p 194 (easy-menu-define eudc-hotlist-emacs-menu 195 eudc-hotlist-mode-map 196 "" 197 eudc-hotlist-menu)) 198 199;;; arch-tag: 9b633ab3-6a6e-4b46-b12e-d96739a7e0e8 200;;; eudc-hotlist.el ends here 201