Mercurial > hg > xemacs-beta
comparison lisp/packages/gopher.el @ 0:376386a54a3c r19-14
Import from CVS: tag r19-14
| author | cvs |
|---|---|
| date | Mon, 13 Aug 2007 08:45:50 +0200 |
| parents | |
| children | ec9a17fef872 |
comparison
equal
deleted
inserted
replaced
| -1:000000000000 | 0:376386a54a3c |
|---|---|
| 1 ;;; gopher.el --- an emacs gopher client | |
| 2 | |
| 3 ;; Copyright (C) 1992 scott snyder | |
| 4 | |
| 5 ;; Author: scott snyder <snyder@fnald0.fnal.gov> | |
| 6 ;; Created: 29 Jun 1992 | |
| 7 ;; Version: 1.03 | |
| 8 ;; Keywords: gopher, comm | |
| 9 | |
| 10 ;; LCD Archive Entry: | |
| 11 ;; gopher|scott snyder|snyder@fnald0.fnal.gov| | |
| 12 ;; An emacs gopher client.| | |
| 13 ;; 20-Apr-1993|1.02|~/interfaces/gopher.el.Z| | |
| 14 | |
| 15 ;; This file is not part of GNU Emacs, but is distributed under the | |
| 16 ;; same conditions. | |
| 17 ;; | |
| 18 ;; GNU Emacs is distributed in the hope that it will be useful, | |
| 19 ;; but WITHOUT ANY WARRANTY. No author or distributor | |
| 20 ;; accepts responsibility to anyone for the consequences of using it | |
| 21 ;; or for whether it serves any particular purpose or works at all, | |
| 22 ;; unless he says so in writing. Refer to the GNU Emacs General Public | |
| 23 ;; License for full details. | |
| 24 ;; | |
| 25 ;; Everyone is granted permission to copy, modify and redistribute | |
| 26 ;; GNU Emacs, but only under the conditions described in the | |
| 27 ;; GNU Emacs General Public License. A copy of this license is | |
| 28 ;; supposed to have been given to you along with GNU Emacs so you | |
| 29 ;; can know your rights and responsibilities. It should be in a | |
| 30 ;; file named COPYING. Among other things, the copyright notice | |
| 31 ;; and this notice must be preserved on all copies. | |
| 32 ;; | |
| 33 ;;; Synched up with: Not in FSF. | |
| 34 ;; | |
| 35 ;; An emacs gopher client. Currently supports directory, text, CSO, | |
| 36 ;; index, image, and telnet objects. | |
| 37 ;; Requires forms.el and background.el. | |
| 38 ;; | |
| 39 ;; Written by scott snyder <snyder@fnald0.fnal.gov> | |
| 40 ;; Some code borrowed from GNUS (by Masanobu UMEDA). | |
| 41 ;; Some code (bookmarks, xterms, error handling) contributed | |
| 42 ;; by Stewart Clamen <clamen@cs.cmu.edu>. | |
| 43 | |
| 44 ;;; Commentary: | |
| 45 ;; OPERATING INSTRUCTIONS | |
| 46 ;; | |
| 47 ;; To use, `M-x gopher'. To specify a different root server, use | |
| 48 ;; `C-u M-x gopher'. If you want to use bookmarks, set the variable | |
| 49 ;; gopher-support-bookmarks appropriately. | |
| 50 ;; The command `M-x gopher-atpoint' will attempt to interpret the text | |
| 51 ;; around point as a gopher bookmark specification and will retrieve | |
| 52 ;; that item. | |
| 53 ;; | |
| 54 ;; Sample .emacs configuration: | |
| 55 ;; (autoload 'gopher "gopher") | |
| 56 ;; (autoload 'gopher-atpoint "gopher") | |
| 57 ;; (setq gopher-support-bookmarks t) | |
| 58 ;; | |
| 59 ;; In directory mode: | |
| 60 ;; Space, return, `f', or `e' selects the line point is on. | |
| 61 ;; With a numeric prefix argument, select that object. | |
| 62 ;; `q', `l', or `u' will return to the previous node. | |
| 63 ;; `n' and `p' to the next and previous lines. | |
| 64 ;; `a' will add an object to your bookmark list. | |
| 65 ;; `v' will display your bookmark list. | |
| 66 ;; `=' gives detailed information about an object. | |
| 67 ;; In the bookmark list, all of the above (except `a'), plus: | |
| 68 ;; `C-k' will delete an object from the bookmark list. | |
| 69 ;; `C-y' will yank the most recently deleted bookmark object back into | |
| 70 ;; the bookmark buffer. | |
| 71 ;; `s' will save the bookmark list. | |
| 72 ;; `Q' will quit gopher entirely, killing all gopher buffers. | |
| 73 ;; | |
| 74 ;; All commands which operate on a specific object can take an optional | |
| 75 ;; numeric prefix argument giving the index of the object on which | |
| 76 ;; to operate. | |
| 77 ;; | |
| 78 ;; In document mode: | |
| 79 ;; Space pages forward. | |
| 80 ;; Delete pages backward. | |
| 81 ;; `q', `l' or `u' returns to the last node. | |
| 82 ;; | |
| 83 ;; In the CSO entry form: | |
| 84 ;; `C-c RET' performs a look-up, based on the field contents | |
| 85 ;; you've filed in. | |
| 86 ;; `C-c l' returns to the previous node. | |
| 87 ;; | |
| 88 ;; Telnets: | |
| 89 ;; If you have an X server set, gopher will try to create an xterm | |
| 90 ;; running telnet. If not, the emacs-lisp telnet mode will be used. | |
| 91 ;; From the emacs-lisp telnet mode, use `C-c l' to kill the session | |
| 92 ;; and return to the previous node. | |
| 93 ;; See also the variable gopher-telnet-command. | |
| 94 ;; | |
| 95 ;; Images: | |
| 96 ;; Images are displayed using the command gopher-image-display-command. | |
| 97 ;; The default setting for this variable uses xv. | |
| 98 ;; | |
| 99 ;; Note: | |
| 100 ;; If gopher consistently hangs while trying to retrieve an object, | |
| 101 ;; try turning on gopher-buggy-accept (which see). | |
| 102 ;; | |
| 103 ;; VMS notes: | |
| 104 ;; To use this on VMS, you'll need my emacs subprocess patches (recently | |
| 105 ;; posted on gnu.emacs.sources; if you can't find them, send me mail). | |
| 106 ;; To be able to run telnet in a separate decterm, you'll also need | |
| 107 ;; to (setq shell-file-name "docmd") and create the file | |
| 108 ;; emacs_library:[etc]docmd.com containing the following: | |
| 109 ;; $ if p1 .eqs. "-C" then p1 = "" | |
| 110 ;; $ deass sys$input | |
| 111 ;; $ 'p1 'p2 'p3 'p4 'p5 'p6 'p7 'p8 | |
| 112 ;; $ eoj | |
| 113 | |
| 114 ;;; Change Log: | |
| 115 ;; | |
| 116 ;; Version 1.03 30-APR-1993 | |
| 117 ;; * Add a buffer-local variable gopher-obj to all gopher buffers bound | |
| 118 ;; to the description of the object contained in that buffer. | |
| 119 ;; | |
| 120 ;; Version 1.02 20-APR-1993 | |
| 121 ;; * Avoid using replace-regexp in gopher-clean-text. (Suggested by | |
| 122 ;; sbyrnes@rice.edu (Steven Byrnes)). | |
| 123 ;; * Added gopher-port-aliases. | |
| 124 ;; * Print ports as strings in gopher-directory-show-object. | |
| 125 ;; * Don't (ding) when the net stream closes unexpectedly. | |
| 126 ;; * Added image display (based on code from beldar@MicroUnity.com | |
| 127 ;; (Gardner Cohen)). | |
| 128 ;; * Attempt to improve error reporting. | |
| 129 ;; * Reworked gopher-parse-bookmark to handle out-of-order fields. | |
| 130 ;; * Added gopher-atpoint. | |
| 131 ;; * Moved bookmark init stuff to gopher-read-bookmarks. | |
| 132 ;; * Added gopher-quit (based on code from Thomas L|fgren | |
| 133 ;; <tde9104@abacus.hgs.se>). | |
| 134 ;; * Change usage of background for XEmacs. | |
| 135 ;; (Patch from "William M. Perry" <wmperry@raisin.ucs.indiana.edu>). | |
| 136 ;; * Added a (provide 'gopher) at end. | |
| 137 ;; * Added `f' and `e' bindings in directory mode. | |
| 138 ;; | |
| 139 ;; Version 1.01 | |
| 140 ;; * Added patch suggested by Humberto Ortiz-Zuazaga | |
| 141 ;; <zuazaga@ucunix.san.uc.EDU> to allow null Path= items in .gopherrc. | |
| 142 ;; | |
| 143 ;; Version 1.00 29-AUG-1992 | |
| 144 ;; * Added gopher-buggy-accept. | |
| 145 ;; * Reworked telnet stuff to use an arbitrary command string to start up | |
| 146 ;; the telnet process. This can be used to start the telnet in a | |
| 147 ;; separate terminal window. | |
| 148 ;; Based on code from Stewart Clamen. | |
| 149 ;; * Stewart Clamen <clamen@cs.cmu.edu> added bookmarks. | |
| 150 ;; * Added 's key binding to save bookmarks. | |
| 151 ;; * Added a prefix argument to gopher-directory-buffer and | |
| 152 ;; gopher-add-bookmark. | |
| 153 ;; * Added standard emacs-lisp header. | |
| 154 ;; * Stewart Clamen <clamen@cs.cmu.edu> added some error trapping and | |
| 155 ;; recovery (gopher-retrieve-document-cleanly). | |
| 156 ;; * Appended node description to the node's buffer's name. | |
| 157 ;; * Reformat bookmark buffers when returning to them via gopher-last-node | |
| 158 ;; or when an item is deleted. | |
| 159 ;; * Added gopher-yank-bookmark. | |
| 160 ;; * Added gopher-bookmark-modified-tick to prevent reformatting bookmark | |
| 161 ;; buffers needlessly. | |
| 162 ;; | |
| 163 ;; Version 0.92 27-JUL-1992 | |
| 164 ;; * Added gopher-hostname-aliases. | |
| 165 ;; | |
| 166 ;; Version 0.91 30-JUN-1992 | |
| 167 ;; * Deal with servers which send stuff after the CR. | |
| 168 ;; * Prevent gopher-directory-show-object from clearing the read-only flag. | |
| 169 ;; * Allow specification of port number in `C-u M-x gopher'. | |
| 170 ;; | |
| 171 ;; Version 0.9 29-JUN-1992 | |
| 172 ;; * Initial release. | |
| 173 | |
| 174 ;;; Code: | |
| 175 | |
| 176 (require 'electric) | |
| 177 (require 'forms) | |
| 178 | |
| 179 ;; background has the same name as an epoch function. | |
| 180 ;; Rename it to gopher-background... | |
| 181 ;; also, the version i got from the archive didn't have a provide... | |
| 182 (cond ((and (string-lessp "19" emacs-version) | |
| 183 (not (boundp 'epoch::version))) | |
| 184 ;; background is obsolete in emacs19: just add a & to shell-command. | |
| 185 (defun gopher-background (command) | |
| 186 (shell-command (concat command "&")))) | |
| 187 (t | |
| 188 ;; background has the same name as an epoch function. | |
| 189 ;; Rename it to gopher-background... | |
| 190 ;; also, the version i got from the archive didn't have a provide... | |
| 191 (if (not (fboundp 'gopher-background)) | |
| 192 (if (fboundp 'background) | |
| 193 (let ((old-background (symbol-function 'background))) | |
| 194 (load-library "background") | |
| 195 (fset 'gopher-background (symbol-function 'background)) | |
| 196 (fset 'background old-background)) | |
| 197 (load-library "background") | |
| 198 (fset 'gopher-background (symbol-function 'background)) | |
| 199 )) | |
| 200 )) | |
| 201 | |
| 202 (defvar gopher-root-node (vector ?1 "root" "" "ucs_gopher" 70) | |
| 203 "The root gopher server, as a gopher object.") | |
| 204 | |
| 205 (defvar gopher-directory-mode-hook nil | |
| 206 "*Invoked when entering a new gopher directory.") | |
| 207 (defvar gopher-directory-mode-map (make-keymap) | |
| 208 "Keymap for gopher-directory-mode.") | |
| 209 | |
| 210 (defvar gopher-document-mode-hook nil | |
| 211 "*Invoked when showing gopher document.") | |
| 212 (defvar gopher-document-mode-map (make-keymap) | |
| 213 "Keymap for gopher-document-mode.") | |
| 214 | |
| 215 (defvar gopher-form-mode-hooks nil | |
| 216 "*Invoked with entering a gopher form (i.e., for CSO).") | |
| 217 (defvar gopher-form-mode-map (make-keymap) | |
| 218 "Keymap for gopher-form-mode.") | |
| 219 | |
| 220 (defvar gopher-tmp-buf nil | |
| 221 "Buffer used to receive output from gopher.") | |
| 222 | |
| 223 (defvar gopher-debug-read t | |
| 224 "*If non-nil, show the current status about reading the gopher server output.") | |
| 225 | |
| 226 ;; On some systems (such as SGI Iris), accept-process-output doesn't seem | |
| 227 ;; to return for the last packet received on a connection. Turn this on | |
| 228 ;; to work around the problem, but does anyone know what causes this? | |
| 229 (defvar gopher-buggy-accept nil | |
| 230 "*If non-nil, use sit-for instead of accept-process-output. | |
| 231 If gopher consistently hangs while fetching an object, try turning this on.") | |
| 232 | |
| 233 (defvar gopher-hostname-aliases | |
| 234 '(("128.230.33.31" . "oliver.syr.edu")) | |
| 235 "Emacs can't deal with raw IP addresses used as a hostname. | |
| 236 Use this to work around...") | |
| 237 | |
| 238 (defvar gopher-port-aliases | |
| 239 '(("whois_port" . 43)) | |
| 240 "Some losing hosts send a port name instead of a number. | |
| 241 Use this table to convert...") | |
| 242 | |
| 243 | |
| 244 (defvar gopher-support-bookmarks nil | |
| 245 "*If nil, do not implement bookmarks. | |
| 246 If 'unix or t, read and write bookmarks to ~/.gopherrc. | |
| 247 If a filename, read and save vector from there directly (not implemented yet). | |
| 248 If a vector, treat as a built-in directory.") | |
| 249 | |
| 250 (defconst gopher-bookmarks nil "Internal bookmark directory.") | |
| 251 (defconst gopher-bookmarks-modified nil "Do bookmarks need to be saved?") | |
| 252 (defconst gopher-killed-bookmark nil "The last bookmark object to be killed") | |
| 253 (defconst gopher-bookmark-directory-p nil | |
| 254 "Is this buffer a bookmark directory? A buffer-local variable.") | |
| 255 | |
| 256 (defvar gopher-bookmark-modified-tick 0 | |
| 257 "Counts each time the bookmark vector is modified.") | |
| 258 | |
| 259 | |
| 260 (defvar gopher-telnet-command | |
| 261 (cond ((eq system-type 'vax-vms) | |
| 262 (if (getenv "DECW$DISPLAY") | |
| 263 "create/terminal/wait/window=(title=\"telnet\") telnet")) | |
| 264 (t | |
| 265 (if (getenv "DISPLAY") | |
| 266 "xterm -e telnet")) | |
| 267 ) | |
| 268 "*Command to use to start a telnet session. | |
| 269 If this is nil, the emacs-lisp telnet package will be used. | |
| 270 The default setting is to create a terminal window running telnet | |
| 271 if you've specified an X server, and to use the emacs-lisp telnet otherwise.") | |
| 272 | |
| 273 | |
| 274 (defvar gopher-image-display-command "xv -geometry +200+200" | |
| 275 "*The command used to try to display an image object.") | |
| 276 | |
| 277 | |
| 278 (defvar gopher-object-type-alist | |
| 279 '(( ?0 "" gopher-document-object) | |
| 280 ( ?1 "/" gopher-directory-object) | |
| 281 ( ?2 " <CSO>" gopher-cso-object) | |
| 282 ( ?3 " <error>" gopher-unimplemented-object) | |
| 283 ( ?4 " <binhex>" gopher-binary-object) | |
| 284 ( ?5 " <DOS>" gopher-binary-object) | |
| 285 ( ?6 " <UU>" gopher-binary-object) | |
| 286 ( ?7 " <?>" gopher-index-object) | |
| 287 ( ?8 " <TEL>" gopher-telnet-object) | |
| 288 ( ?9 " <bin>" gopher-binary-object) | |
| 289 ( ?T " <T>" gopher-unimplemented-object) | |
| 290 ( ?s " <)" gopher-binary-object) | |
| 291 ( ?M " <MIME>" gopher-unimplemented-object) | |
| 292 ( ?h " <html>" gopher-unimplemented-object) | |
| 293 ( ?I " <image>" gopher-image-object) | |
| 294 ( ?c " <cal>" gopher-unimplemented-object) | |
| 295 ( ?g " <GIF>" gopher-image-object) | |
| 296 ) | |
| 297 "*Alist describing the types of gopher objects this client know about. | |
| 298 The keys are the gopher type characters. | |
| 299 The second element in each list is the string to tag onto the end | |
| 300 of an object's description, to identify it to the user. | |
| 301 The third element is the function to use to retrieve the object. | |
| 302 It is called with two arguments: the gopher object to retrieve and | |
| 303 the buffer which should be returned to when the user is done | |
| 304 with this object.") | |
| 305 | |
| 306 | |
| 307 ;;; | |
| 308 ;;; The data structure describing a gopher object is a vector of five elements: | |
| 309 ;;; [ TYPE DESCR SELECTOR HOST PORT ] | |
| 310 ;;; | |
| 311 ;;; TYPE is the type character. | |
| 312 ;;; DESCR is the human-readable description of the object. | |
| 313 ;;; SELECTOR is the opaque selector to be sent to HOST to retrieve the obj. | |
| 314 ;;; HOST is the name of the Internet host on which the object resides. | |
| 315 ;;; PORT is the TCP/IP port on which the host is listening. | |
| 316 ;;; | |
| 317 ;;; The following macros set and fetch elements of this structure. | |
| 318 ;;; | |
| 319 | |
| 320 (defconst gopher-object-length 5) | |
| 321 | |
| 322 (defmacro gopher-object-type (object) | |
| 323 "Return the gopher type of OBJECT." | |
| 324 (` (aref (, object) 0))) | |
| 325 | |
| 326 (defmacro gopher-object-descr (object) | |
| 327 "Return the gopher description of OBJECT." | |
| 328 (` (aref (, object) 1))) | |
| 329 | |
| 330 (defmacro gopher-object-selector (object) | |
| 331 "Return the gopher selector string for OBJECT." | |
| 332 (` (aref (, object) 2))) | |
| 333 | |
| 334 (defmacro gopher-object-host (object) | |
| 335 "Return the gopher hostname for OBJECT." | |
| 336 (` (aref (, object) 3))) | |
| 337 | |
| 338 (defmacro gopher-object-port (object) | |
| 339 "Return the gopher TCP port number for OBJECT." | |
| 340 (` (aref (, object) 4))) | |
| 341 | |
| 342 | |
| 343 (defmacro gopher-set-object-type (object type) | |
| 344 "Set the gopher type of OBJECT to TYPE." | |
| 345 (` (aset (, object) 0 (, type)))) | |
| 346 | |
| 347 (defmacro gopher-set-object-descr (object descr) | |
| 348 "Set the gopher description of OBJECT to DESCR." | |
| 349 (` (aset (, object) 1 (, descr)))) | |
| 350 | |
| 351 (defmacro gopher-set-object-selector (object selector) | |
| 352 "Set the gopher selector string for OBJECT to SELECTOR." | |
| 353 (` (aset (, object) 2 (, selector)))) | |
| 354 | |
| 355 (defmacro gopher-set-object-host (object host) | |
| 356 "Set the gopher hostname for OBJECT to HOST." | |
| 357 (` (aset (, object) 3 (, host)))) | |
| 358 | |
| 359 (defmacro gopher-set-object-port (object port) | |
| 360 "Set the gopher TCP port number for OBJECT to PORT." | |
| 361 (` (aset (, object) 4 (, port)))) | |
| 362 | |
| 363 | |
| 364 (defmacro gopher-retrieve-document-cleanly (args handle &rest body) | |
| 365 "Call gopher-retrieve-document with condition-case wrapped around, | |
| 366 applying HANDLE if appropriate." | |
| 367 (` (condition-case nil | |
| 368 (progn | |
| 369 (gopher-retrieve-document (,@ args)) | |
| 370 (,@ body)) | |
| 371 (error (, handle))))) | |
| 372 | |
| 373 | |
| 374 ;; | |
| 375 ;; buffer-local variables. | |
| 376 ;; declared here to prevent warnings from the new byte-compiler. | |
| 377 ;; | |
| 378 | |
| 379 (defvar gopher-dir nil) | |
| 380 (defvar gopher-last nil) | |
| 381 (defvar gopher-obj nil) | |
| 382 (defvar gopher-telnet-process-name nil) | |
| 383 (defvar gopher-bookmark-buffer-tick nil) | |
| 384 (defvar forms-accept-action nil) | |
| 385 | |
| 386 | |
| 387 ;;;;-------------------------------------------------------------------------- | |
| 388 ;;;; main dispatching logic. | |
| 389 ;;;; | |
| 390 | |
| 391 ;;;###autoload | |
| 392 (defun gopher (&optional askserv) | |
| 393 "Start a gopher session. With C-u, prompt for a gopher server." | |
| 394 (interactive "P") | |
| 395 (if askserv | |
| 396 (progn | |
| 397 (gopher-set-object-host | |
| 398 gopher-root-node | |
| 399 (read-string "Gopher server: " | |
| 400 (gopher-object-host gopher-root-node))) | |
| 401 | |
| 402 (let (portstr port) | |
| 403 (while (not (numberp port)) | |
| 404 (setq portstr | |
| 405 (read-string "Port: " | |
| 406 (int-to-string | |
| 407 (gopher-object-port gopher-root-node)))) | |
| 408 | |
| 409 (setq port (condition-case nil | |
| 410 (car (read-from-string portstr)) | |
| 411 (error nil))) | |
| 412 | |
| 413 (if (not (numberp port)) | |
| 414 (progn | |
| 415 (ding) | |
| 416 (message "Port must be numeric") | |
| 417 (sit-for 1))) | |
| 418 ) | |
| 419 | |
| 420 (gopher-set-object-port gopher-root-node port)))) | |
| 421 | |
| 422 (gopher-read-bookmarks) | |
| 423 | |
| 424 (gopher-dispatch-object gopher-root-node nil)) | |
| 425 | |
| 426 | |
| 427 | |
| 428 ;;;###autoload | |
| 429 (defun gopher-atpoint nil | |
| 430 "Try to interpret the text around point as a gopher bookmark, and dispatch | |
| 431 to that object." | |
| 432 (interactive) | |
| 433 | |
| 434 (let (bkmk) | |
| 435 (save-excursion | |
| 436 (re-search-backward "^#[ \t]*$\\|^[ \t]*$\\|\\`") | |
| 437 (skip-chars-forward " \t\n") | |
| 438 (setq bkmk (gopher-parse-bookmark))) | |
| 439 (if bkmk | |
| 440 (progn | |
| 441 (gopher-read-bookmarks) | |
| 442 (gopher-dispatch-object bkmk nil)) | |
| 443 (error "Illformed bookmark")))) | |
| 444 | |
| 445 | |
| 446 (defun gopher-dispatch-object (obj lastbuf) | |
| 447 "Dispatch a gopher object depending on its type." | |
| 448 (let ((typedesc (assq (gopher-object-type obj) gopher-object-type-alist))) | |
| 449 | |
| 450 (if typedesc | |
| 451 (funcall (nth 2 typedesc) obj lastbuf) | |
| 452 (gopher-unimplemented-object obj lastbuf)))) | |
| 453 | |
| 454 | |
| 455 (defun gopher-unimplemented-object (obj lastbuf) | |
| 456 (error "unimplemented object type")) | |
| 457 | |
| 458 | |
| 459 ;;;;-------------------------------------------------------------------------- | |
| 460 ;;;; utilities | |
| 461 ;;;; | |
| 462 | |
| 463 (defun gopher-next-field nil | |
| 464 "Returns as a string all chars between point and the next tab or newline. | |
| 465 Point is advanced to after the tab (or to the end-of-line)." | |
| 466 | |
| 467 (let ((beg (point)) s) | |
| 468 (skip-chars-forward "^\t\n") | |
| 469 (setq s (buffer-substring beg (point))) | |
| 470 (if (eq (following-char) ?\t) | |
| 471 (forward-char)) | |
| 472 s)) | |
| 473 | |
| 474 | |
| 475 ;; from GNUS | |
| 476 (defun gopher-make-local-vars (&rest pairs) | |
| 477 ;; Take VARIABLE-VALUE pairs and makes local variables initialized to the | |
| 478 ;; value. | |
| 479 (while pairs | |
| 480 (make-local-variable (car pairs)) | |
| 481 (set (car pairs) (car (cdr pairs))) | |
| 482 (setq pairs (cdr (cdr pairs))))) | |
| 483 | |
| 484 | |
| 485 (defun gopher-get-tmp-buf nil | |
| 486 "Get a temporary buffer in which to receive gopher output." | |
| 487 (or (bufferp gopher-tmp-buf) | |
| 488 (progn | |
| 489 (setq gopher-tmp-buf (get-buffer-create " *gopher-tmp*")) | |
| 490 (buffer-flush-undo gopher-tmp-buf))) | |
| 491 gopher-tmp-buf) | |
| 492 | |
| 493 | |
| 494 (defun gopher-get-dir-buf (descr) | |
| 495 "Get a new buffer suitable for a gopher directory or document." | |
| 496 (let ((buf (generate-new-buffer (concat "*gopher*" descr)))) | |
| 497 (buffer-flush-undo buf) | |
| 498 buf)) | |
| 499 | |
| 500 (fset 'gopher-get-doc-buf (symbol-function 'gopher-get-dir-buf)) | |
| 501 | |
| 502 | |
| 503 (defun gopher-trim-blanks (str) | |
| 504 "Remove leading and trailing blanks from STR." | |
| 505 (string-match "\\`[ \t\n]*" str) | |
| 506 (substring str | |
| 507 (match-end 0) | |
| 508 (string-match "[ \t\n]*\\'" str (match-end 0)))) | |
| 509 | |
| 510 | |
| 511 ;;;;-------------------------------------------------------------------------- | |
| 512 ;;;; directory handling | |
| 513 ;;;; | |
| 514 | |
| 515 | |
| 516 (defun gopher-directory-object (obj oldbuf) | |
| 517 "Retrieve and display a gopher directory." | |
| 518 | |
| 519 (let ((tmpbuf (gopher-get-tmp-buf)) | |
| 520 (dirbuf (gopher-get-dir-buf (gopher-object-descr obj)))) | |
| 521 | |
| 522 ;; Get the directory... | |
| 523 (gopher-retrieve-document-cleanly (tmpbuf | |
| 524 (gopher-object-selector obj) | |
| 525 (gopher-object-host obj) | |
| 526 (gopher-object-port obj)) | |
| 527 | |
| 528 (progn | |
| 529 (kill-buffer dirbuf) | |
| 530 (error "Problems retrieving directory.")) | |
| 531 | |
| 532 ;; Parse it and store our internal representation in gopher-dir. | |
| 533 (switch-to-buffer dirbuf) | |
| 534 (gopher-make-local-vars | |
| 535 'gopher-dir (gopher-parse-directory tmpbuf) | |
| 536 'gopher-obj obj | |
| 537 'gopher-last oldbuf) | |
| 538 | |
| 539 ;; Format it for your viewing pleasure. | |
| 540 (gopher-format-directory gopher-dir dirbuf) | |
| 541 (goto-char (point-min)) | |
| 542 (if (> (- (point-max) (point)) 7) (forward-char 7)) | |
| 543 | |
| 544 ;; Turn on directory mode and put the description in the mode line. | |
| 545 (gopher-directory-mode) | |
| 546 (setq mode-line-buffer-identification (concat "Gopher: " | |
| 547 (gopher-object-descr obj))) | |
| 548 ))) | |
| 549 | |
| 550 | |
| 551 (defun gopher-parse-directory (buf) | |
| 552 "Parse the gopher directory in buffer BUF into our internal representation. | |
| 553 Returns a vector of gopher objects." | |
| 554 | |
| 555 (save-excursion | |
| 556 (set-buffer buf) | |
| 557 (goto-char (point-min)) | |
| 558 | |
| 559 (let* ((len (count-lines (point-min) (point-max))) | |
| 560 (dir (make-vector len nil)) | |
| 561 (i 0)) | |
| 562 | |
| 563 (while (not (eobp)) | |
| 564 (aset dir i (gopher-parse-directory-line)) | |
| 565 (setq i (1+ i)) | |
| 566 (forward-line 1)) | |
| 567 | |
| 568 dir))) | |
| 569 | |
| 570 | |
| 571 (defun gopher-parse-directory-line nil | |
| 572 "Parse the line containing point as a gopher directory entry. | |
| 573 Returns the corresponding gopher object." | |
| 574 | |
| 575 (let (type descr selector host port) | |
| 576 (beginning-of-line) | |
| 577 (setq type (following-char)) | |
| 578 (forward-char) | |
| 579 (setq descr (gopher-next-field)) | |
| 580 (setq selector (gopher-next-field)) | |
| 581 (setq host (gopher-next-field)) | |
| 582 (setq port (gopher-next-field)) | |
| 583 | |
| 584 (if (string-match "^[0-9]+$" port) | |
| 585 (setq port (string-to-int port))) | |
| 586 | |
| 587 (vector type descr selector host port))) | |
| 588 | |
| 589 | |
| 590 (defun gopher-format-directory (dir buf) | |
| 591 "Print the directory vector DIR into buffer BUF." | |
| 592 | |
| 593 (save-excursion | |
| 594 (set-buffer buf) | |
| 595 (erase-buffer) | |
| 596 (let ((i 0) | |
| 597 (len (length dir))) | |
| 598 (while (< i len) | |
| 599 (gopher-format-directory-line (aref dir i) (1+ i)) | |
| 600 (setq i (1+ i))) | |
| 601 | |
| 602 ))) | |
| 603 | |
| 604 | |
| 605 (defun gopher-format-directory-line (obj ndx) | |
| 606 "Insert a line describing the gopher object OBJ into the current buffer. | |
| 607 NDX is a numeric index to display to the left of the object description." | |
| 608 | |
| 609 (let ((ndx-str (int-to-string ndx)) | |
| 610 (typedesc (assq (gopher-object-type obj) gopher-object-type-alist))) | |
| 611 | |
| 612 ;; display the index number. use 5 digits, right-justified. | |
| 613 (if (< (length ndx-str) 5) | |
| 614 (insert (make-string (- 5 (length ndx-str)) ? ))) | |
| 615 (insert ndx-str) | |
| 616 (insert ". ") | |
| 617 | |
| 618 ;; add the object description. | |
| 619 (insert (gopher-object-descr obj)) | |
| 620 | |
| 621 ;; add a tag indicating the gopher object type. | |
| 622 (insert (if typedesc | |
| 623 (nth 1 typedesc) | |
| 624 (concat " ???" (char-to-string (gopher-object-type obj))))) | |
| 625 | |
| 626 (insert "\n"))) | |
| 627 | |
| 628 | |
| 629 (defun gopher-directory-mode nil | |
| 630 "Gopher directory mode. | |
| 631 | |
| 632 \\{gopher-directory-mode-map} | |
| 633 " | |
| 634 (use-local-map gopher-directory-mode-map) | |
| 635 (setq major-mode 'gopher-directory-mode) | |
| 636 (setq mode-name "gopher dir") | |
| 637 (run-hooks 'gopher-directory-mode-hook) | |
| 638 (setq buffer-read-only t) | |
| 639 | |
| 640 (require 'mode-motion) | |
| 641 (make-local-variable 'mode-motion-hook) | |
| 642 (setq mode-motion-hook 'mode-motion-highlight-line) | |
| 643 ) | |
| 644 | |
| 645 ;;; keymap for directory mode | |
| 646 (suppress-keymap gopher-directory-mode-map) | |
| 647 (define-key gopher-directory-mode-map "\r" 'gopher-directory-choose) | |
| 648 (define-key gopher-directory-mode-map " " 'gopher-directory-choose) | |
| 649 (define-key gopher-directory-mode-map "l" 'gopher-last-node) | |
| 650 (define-key gopher-directory-mode-map "q" 'gopher-last-node) | |
| 651 (define-key gopher-directory-mode-map "u" 'gopher-last-node) | |
| 652 (define-key gopher-directory-mode-map "=" 'gopher-directory-show-object) | |
| 653 (define-key gopher-directory-mode-map "Q" 'gopher-quit) | |
| 654 (define-key gopher-directory-mode-map "f" 'gopher-directory-choose) | |
| 655 (define-key gopher-directory-mode-map "e" 'gopher-directory-choose) | |
| 656 | |
| 657 ; Virginia Peck <vapeck@cs> Mon Aug 10 1992 | |
| 658 (define-key gopher-directory-mode-map "n" 'next-line) | |
| 659 (define-key gopher-directory-mode-map "p" 'previous-line) | |
| 660 ;;(define-key gopher-directory-mode-map "\C-xk" 'gopher-last-node) | |
| 661 | |
| 662 ; Stewart Clamen <clamen@cs.cmu.edu> Mon Aug 17 1992 | |
| 663 (define-key gopher-directory-mode-map "v" 'gopher-display-bookmarks) | |
| 664 (define-key gopher-directory-mode-map "a" 'gopher-add-bookmark) | |
| 665 (define-key gopher-directory-mode-map "\C-k" 'gopher-delete-bookmark) | |
| 666 (define-key gopher-directory-mode-map "s" 'gopher-directory-save-bookmarks) | |
| 667 (define-key gopher-directory-mode-map "\C-y" 'gopher-yank-bookmark) | |
| 668 | |
| 669 (define-key gopher-directory-mode-map 'button2 'gopher-mouse-directory-choose) | |
| 670 (define-key gopher-directory-mode-map 'button3 'gopher-directory-menu) | |
| 671 | |
| 672 | |
| 673 (defvar gopher-directory-menu | |
| 674 '("Gopher Commands" | |
| 675 ["Select This Link" gopher-directory-choose t] | |
| 676 ["Goto Last Node" gopher-last-node t] | |
| 677 ["Show Object Internals" gopher-directory-show-object t] | |
| 678 ["Quit" gopher-quit t] | |
| 679 )) | |
| 680 | |
| 681 (defun gopher-directory-menu (event) | |
| 682 (interactive "e") | |
| 683 (mouse-set-point event) | |
| 684 (beginning-of-line) | |
| 685 (popup-menu gopher-directory-menu)) | |
| 686 | |
| 687 (defun gopher-mouse-directory-choose (event arg) | |
| 688 (interactive "e\nP") | |
| 689 (mouse-set-point event) | |
| 690 (beginning-of-line) | |
| 691 (gopher-directory-choose arg)) | |
| 692 | |
| 693 | |
| 694 (defun gopher-directory-nth-obj (n) | |
| 695 "Returns the Nth object (starting at 1) in a gopher directory buffer." | |
| 696 (if (or (<= n 0) (> n (length gopher-dir))) | |
| 697 (error "Out of range.")) | |
| 698 (aref gopher-dir (1- n))) | |
| 699 | |
| 700 | |
| 701 (defun gopher-directory-n (arg) | |
| 702 "Return the index of the object specified by ARG (starting at 1). | |
| 703 If ARG is nil, this is the index of the current line. | |
| 704 Otherwise, it is the value of ARG (as a prefix argument)." | |
| 705 (if arg | |
| 706 (prefix-numeric-value arg) | |
| 707 (if (eq (point) (point-max)) | |
| 708 (1+ (count-lines (point-min) (point-max))) | |
| 709 (count-lines (point-min) (1+ (point)))))) | |
| 710 | |
| 711 | |
| 712 (defun gopher-directory-obj (arg) | |
| 713 "Return the gopher object given by prefix arg ARG. | |
| 714 If it is nil, return the object given by the line point is on. | |
| 715 Otherwise, ARG is the index of the object." | |
| 716 (gopher-directory-nth-obj (gopher-directory-n arg))) | |
| 717 | |
| 718 | |
| 719 (defun gopher-directory-choose (arg) | |
| 720 "Choose an item from the directory, and do whatever is appropriate | |
| 721 based on the object's type. Default is to choose the object given by the | |
| 722 line the cursor is on. With numeric prefix argument N, choose object N." | |
| 723 (interactive "P") | |
| 724 (gopher-dispatch-object (gopher-directory-obj arg) (current-buffer))) | |
| 725 | |
| 726 | |
| 727 (defun gopher-directory-show-object (arg) | |
| 728 "Dump the internal information in a gopher object. | |
| 729 With numeric prefix argument N, show information about the Nth object." | |
| 730 (interactive "P") | |
| 731 (let* ((obj (gopher-directory-obj arg)) | |
| 732 (type (gopher-object-type obj)) | |
| 733 (typespec (assq type gopher-object-type-alist)) | |
| 734 (typetag (if typespec (nth 1 typespec) "?")) | |
| 735 (typeproc (if typespec (nth 2 typespec) "?"))) | |
| 736 (with-output-to-temp-buffer "*Gopher object*" | |
| 737 (princ (format "Type : %c `%s' %s\n" type typetag typeproc)) | |
| 738 (princ (format "Description : %s\n" (gopher-object-descr obj))) | |
| 739 (princ (format "Selector : %s\n" (gopher-object-selector obj))) | |
| 740 (princ (format "Host : %s\n" (gopher-object-host obj))) | |
| 741 (princ (format "Port : %s\n" (gopher-object-port obj))) | |
| 742 (current-buffer) | |
| 743 )) | |
| 744 (shrink-window-if-larger-than-buffer (get-buffer-window "*Gopher object*")) | |
| 745 | |
| 746 ;; shrink-window-if-larger-than-buffer screws these up... | |
| 747 (set-buffer-modified-p nil) | |
| 748 (setq buffer-read-only t)) | |
| 749 | |
| 750 | |
| 751 (defun gopher-last-node nil | |
| 752 "Return to the previous gopher node. | |
| 753 By convention, a gopher buffer has the local variable gopher-last which | |
| 754 contains the buffer to which we should return." | |
| 755 (interactive) | |
| 756 (let ((oldbuf (current-buffer))) | |
| 757 (if gopher-last | |
| 758 (progn | |
| 759 (switch-to-buffer gopher-last) | |
| 760 (kill-buffer oldbuf) | |
| 761 (and (gopher-bookmark-directory-p) | |
| 762 (> gopher-bookmark-modified-tick gopher-bookmark-buffer-tick) | |
| 763 (let ((ppos (1- (gopher-directory-n nil)))) | |
| 764 (gopher-format-bookmarks) | |
| 765 (forward-line ppos) | |
| 766 (if (> (- (point-max) (point)) 7) (forward-char 7))))) | |
| 767 (if (and gopher-support-bookmarks | |
| 768 gopher-bookmarks-modified | |
| 769 (y-or-n-p | |
| 770 "Changes have been made to the Bookmark directory. Save? ")) | |
| 771 (gopher-save-bookmarks)) | |
| 772 (kill-buffer oldbuf)))) | |
| 773 | |
| 774 | |
| 775 (defun gopher-directory-save-bookmarks () | |
| 776 "Save the bookmark list." | |
| 777 (interactive) | |
| 778 | |
| 779 (if (not (gopher-bookmark-directory-p)) | |
| 780 (error "This isn't the bookmark directory.")) | |
| 781 | |
| 782 (gopher-save-bookmarks)) | |
| 783 | |
| 784 | |
| 785 | |
| 786 ;;; Gopher clean-up and quit. | |
| 787 ;;; Originally from Thomas L|fgren <tde9104@abacus.hgs.se> | |
| 788 | |
| 789 (defun gopher-quit nil | |
| 790 "Quit gopher, and kill all gopher buffers. | |
| 791 If there are unsaved changes to your bookmark directory, you will be | |
| 792 asked if you want to save them" | |
| 793 (interactive) | |
| 794 (if (y-or-n-p "Do you really want to kill all gopher buffers? ") | |
| 795 (progn | |
| 796 (if (and gopher-support-bookmarks | |
| 797 gopher-bookmarks-modified | |
| 798 (y-or-n-p | |
| 799 "Changes have been made to the Bookmark directory. Save? ")) | |
| 800 (gopher-save-bookmarks)) | |
| 801 (let ((buflist (buffer-list)) | |
| 802 (case-fold-search t)) | |
| 803 (while buflist | |
| 804 (if (eq (string-match "\\*gopher" (buffer-name (car buflist))) 0) | |
| 805 (kill-buffer (car buflist))) | |
| 806 (setq buflist (cdr buflist))))))) | |
| 807 | |
| 808 | |
| 809 ;;;;-------------------------------------------------------------------------- | |
| 810 ;;;; bookmarks (Implemented originally by clamen@cs.cmu.edu) | |
| 811 ;;;; | |
| 812 | |
| 813 | |
| 814 (defun gopher-read-bookmarks () | |
| 815 (cond ((null gopher-support-bookmarks)) | |
| 816 ((or (equal gopher-support-bookmarks 'unix) | |
| 817 (equal gopher-support-bookmarks t)) | |
| 818 (setq gopher-bookmarks | |
| 819 (gopher-read-unix-bookmarks))) | |
| 820 ((stringp gopher-support-bookmarks) | |
| 821 (gopher-read-lisp-bookmarks gopher-support-bookmarks)) | |
| 822 ((vectorp gopher-support-bookmarks) | |
| 823 (setq gopher-bookmarks gopher-support-bookmarks)) | |
| 824 (t | |
| 825 (message "Illformed gopher-bookmarks, assuming none")))) | |
| 826 | |
| 827 | |
| 828 (defun gopher-read-unix-bookmarks () | |
| 829 "Read bookmarks out of ~/.gopherrc file." | |
| 830 (let ((rcfile "~/.gopherrc")) | |
| 831 (if (file-exists-p rcfile) | |
| 832 (let* ((rcbuf (find-file-noselect rcfile)) | |
| 833 (bkmks (gopher-parse-bookmark-buffer rcbuf))) | |
| 834 (kill-buffer rcbuf) | |
| 835 (setq gopher-bookmarks-modified nil) | |
| 836 (setq gopher-bookmark-modified-tick | |
| 837 (1+ gopher-bookmark-modified-tick)) | |
| 838 bkmks) | |
| 839 (message "No %s exists." rcfile) | |
| 840 nil))) | |
| 841 | |
| 842 (defun gopher-parse-bookmark-buffer (buf) | |
| 843 "Read buffer containing bookmarks, formatted like ~.gopherrc | |
| 844 in UNIX gopher client." | |
| 845 (save-excursion | |
| 846 (set-buffer buf) | |
| 847 (goto-char (point-min)) | |
| 848 (if (re-search-forward "^bookmarks:\n" (point-max) t) | |
| 849 (let (bkmk bkmks) | |
| 850 (while (setq bkmk (gopher-parse-bookmark)) | |
| 851 (setq bkmks (cons bkmk bkmks))) | |
| 852 (apply 'vector (reverse bkmks)))))) | |
| 853 | |
| 854 (defun gopher-parse-bookmark-line (regexp end setf bkmk) | |
| 855 (save-excursion | |
| 856 (if (re-search-forward regexp end t) | |
| 857 (eval (list setf bkmk | |
| 858 (buffer-substring (match-beginning 1) (match-end 1)))) | |
| 859 ))) | |
| 860 | |
| 861 | |
| 862 (defun gopher-parse-bookmark () | |
| 863 "Read next bookmark. Return a directory object." | |
| 864 (if (looking-at "^#$") | |
| 865 (forward-line)) | |
| 866 (if (not (eobp)) | |
| 867 (let ((end (save-excursion | |
| 868 (forward-line 5) | |
| 869 (point))) | |
| 870 (bkmk (make-vector 5 nil))) | |
| 871 (prog1 | |
| 872 (and (gopher-parse-bookmark-line "^Type *= *\\(.+\\) *$" end | |
| 873 'gopher-set-object-type bkmk) | |
| 874 (gopher-parse-bookmark-line "^Name *= *\\(.*\\) *$" end | |
| 875 'gopher-set-object-descr bkmk) | |
| 876 (gopher-parse-bookmark-line "^Path *= *\\(.*\\) *$" end | |
| 877 'gopher-set-object-selector bkmk) | |
| 878 (gopher-parse-bookmark-line "^Host *= *\\(.+\\) *$" end | |
| 879 'gopher-set-object-host bkmk) | |
| 880 (gopher-parse-bookmark-line "^Port *= *\\(.+\\) *$" end | |
| 881 'gopher-set-object-port bkmk) | |
| 882 (progn | |
| 883 (gopher-set-object-type | |
| 884 bkmk (string-to-char (gopher-object-type bkmk))) | |
| 885 (gopher-set-object-port | |
| 886 bkmk (string-to-int (gopher-object-port bkmk))) | |
| 887 bkmk)) | |
| 888 (goto-char end)) | |
| 889 ))) | |
| 890 | |
| 891 (defun gopher-format-bookmarks () | |
| 892 "Make the current buffer (which is assumed to be a bookmark buffer) | |
| 893 contain an up-to-date listing of the bookmark list." | |
| 894 | |
| 895 (let ((buffer-read-only nil)) | |
| 896 (erase-buffer) | |
| 897 (setq gopher-dir gopher-bookmarks) | |
| 898 | |
| 899 ;; Format it for your viewing pleasure. | |
| 900 (gopher-format-directory gopher-dir (current-buffer)) | |
| 901 (goto-char (point-min)) | |
| 902 (if (> (- (point-max) (point)) 7) (forward-char 7)) | |
| 903 (setq gopher-bookmark-buffer-tick gopher-bookmark-modified-tick))) | |
| 904 | |
| 905 (defun gopher-display-bookmarks () | |
| 906 "Retrieve and display the gopher bookmark directory." | |
| 907 (interactive) | |
| 908 | |
| 909 (if (> (length gopher-bookmarks) 0) | |
| 910 (let ((oldbuf (current-buffer)) | |
| 911 (dirbuf (gopher-get-dir-buf "*Gopher Bookmarks*"))) | |
| 912 | |
| 913 ;; Store our internal representation in gopher-dir. | |
| 914 (switch-to-buffer dirbuf) | |
| 915 (gopher-make-local-vars | |
| 916 'gopher-dir gopher-bookmarks | |
| 917 'gopher-bookmark-directory-p t | |
| 918 'gopher-bookmark-buffer-tick gopher-bookmark-modified-tick | |
| 919 'gopher-obj 'bookmark | |
| 920 'gopher-last oldbuf) | |
| 921 | |
| 922 (gopher-format-bookmarks) | |
| 923 | |
| 924 ;; Turn on directory mode and put the description in the mode line. | |
| 925 (gopher-directory-mode) | |
| 926 (setq mode-line-buffer-identification (concat "Gopher: *Bookmarks*")) | |
| 927 ) | |
| 928 (error "No bookmarks supported."))) | |
| 929 | |
| 930 | |
| 931 (defun gopher-save-bookmarks () | |
| 932 "Save bookmarks." | |
| 933 (cond | |
| 934 ((or (equal gopher-support-bookmarks 'unix) | |
| 935 (equal gopher-support-bookmarks t)) | |
| 936 (gopher-save-unix-bookmarks)) | |
| 937 ((stringp gopher-support-bookmarks) | |
| 938 (gopher-save-lisp-bookmarks gopher-support-bookmarks)) | |
| 939 (t | |
| 940 (message "Illformed gopher-support-bookmarks, assuming none"))) | |
| 941 | |
| 942 (setq gopher-bookmarks-modified nil)) | |
| 943 | |
| 944 | |
| 945 (defun gopher-save-unix-bookmarks () | |
| 946 "Save bookmarks out to ~/.gopherrc file." | |
| 947 (save-excursion | |
| 948 (let* ((rcfile "~/.gopherrc") | |
| 949 (new-file-p (not (file-exists-p rcfile))) | |
| 950 (rcbuf (find-file-noselect rcfile))) | |
| 951 (set-buffer rcbuf) | |
| 952 (if new-file-p | |
| 953 (insert "bookmarks:\n") | |
| 954 (goto-char (point-min)) | |
| 955 (if (re-search-forward "^bookmarks:\n" nil t) | |
| 956 (delete-region (point) (point-max)) | |
| 957 (goto-char (point-max)) | |
| 958 (insert "bookmarks:\n"))) | |
| 959 | |
| 960 ;; Now, insert defined bookmarks into file | |
| 961 | |
| 962 (let ((obj-count 0)) | |
| 963 (while (< obj-count (length gopher-bookmarks)) | |
| 964 (let ((obj (aref gopher-bookmarks obj-count))) | |
| 965 (insert "#" | |
| 966 "\nType=" (gopher-object-type obj) | |
| 967 "\nName=" (gopher-object-descr obj) | |
| 968 "\nPath=" (gopher-object-selector obj) | |
| 969 "\nHost=" (gopher-object-host obj) | |
| 970 "\nPort=" (int-to-string (gopher-object-port obj)) | |
| 971 "\n") | |
| 972 (setq obj-count (1+ obj-count))))) | |
| 973 | |
| 974 (write-file rcfile)))) | |
| 975 | |
| 976 | |
| 977 (defun gopher-add-bookmark (arg) | |
| 978 "Add current object to menu of bookmarks. | |
| 979 With numeric prefix argument N, add Nth object." | |
| 980 (interactive "P") | |
| 981 (if (gopher-bookmark-directory-p) | |
| 982 (error "That item is already a bookmark!") | |
| 983 (let ((existing-bookmarks gopher-bookmarks) | |
| 984 (new-bookmarks (make-vector (1+ (length gopher-bookmarks)) nil)) | |
| 985 (obj (copy-sequence (gopher-directory-obj arg))) | |
| 986 (l (length gopher-bookmarks))) | |
| 987 (gopher-set-object-descr | |
| 988 obj | |
| 989 (read-from-minibuffer "Node Name: " | |
| 990 (gopher-object-descr obj))) | |
| 991 (aset new-bookmarks l obj) | |
| 992 (while (> l 0) | |
| 993 (progn (setq l (1- l)) | |
| 994 (aset new-bookmarks l (aref existing-bookmarks l)))) | |
| 995 (setq gopher-bookmarks new-bookmarks | |
| 996 gopher-bookmarks-modified t | |
| 997 gopher-bookmark-modified-tick (1+ gopher-bookmark-modified-tick)) | |
| 998 ))) | |
| 999 | |
| 1000 | |
| 1001 (defun gopher-delete-bookmark (arg) | |
| 1002 "Delete current bookmark. | |
| 1003 With numeric prefix argument N, delete Nth bookmark." | |
| 1004 (interactive "P") | |
| 1005 (if (not (gopher-bookmark-directory-p)) | |
| 1006 (error "Can only delete object in Bookmark directory.") | |
| 1007 (let ((new-bookmarks (make-vector (1- (length gopher-bookmarks)) nil)) | |
| 1008 (pos (1- (gopher-directory-n arg))) | |
| 1009 (l (length gopher-bookmarks)) | |
| 1010 (i 0)) | |
| 1011 (while (< i pos) | |
| 1012 (progn (aset new-bookmarks i (aref gopher-bookmarks i)) | |
| 1013 (setq i (1+ i)))) | |
| 1014 (while (< i (1- l)) | |
| 1015 (progn (aset new-bookmarks i (aref gopher-bookmarks (1+ i))) | |
| 1016 (setq i (1+ i)))) | |
| 1017 (setq gopher-killed-bookmark (aref gopher-bookmarks pos) | |
| 1018 gopher-bookmarks new-bookmarks | |
| 1019 gopher-dir new-bookmarks | |
| 1020 gopher-bookmarks-modified t | |
| 1021 gopher-bookmark-modified-tick (1+ gopher-bookmark-modified-tick)) | |
| 1022 (let ((ppos (1- (gopher-directory-n nil)))) | |
| 1023 (if (< pos ppos) | |
| 1024 (setq ppos (1- ppos))) | |
| 1025 (gopher-format-bookmarks) | |
| 1026 (goto-char (point-min)) | |
| 1027 (forward-line ppos) | |
| 1028 (forward-char 7))) | |
| 1029 (if (= (point) (point-max)) (previous-line 1)) | |
| 1030 ; (let ((buffer-read-only nil)) | |
| 1031 ; (beginning-of-line 1) | |
| 1032 ; (kill-line 1) | |
| 1033 ; (if (= (point) (point-max)) (previous-line 1))) | |
| 1034 (if (zerop (length gopher-bookmarks)) | |
| 1035 (gopher-last-node)))) | |
| 1036 | |
| 1037 | |
| 1038 (defun gopher-yank-bookmark (arg) | |
| 1039 "Yank the most recently killed bookmark at the current position. | |
| 1040 With numeric prefix argument N, yank into position N." | |
| 1041 (interactive "P") | |
| 1042 (cond ((not (gopher-bookmark-directory-p)) | |
| 1043 (error "Can only yank bookmark objects into bookmark directory.")) | |
| 1044 ((null gopher-killed-bookmark) | |
| 1045 (error "No killed bookmark object")) | |
| 1046 (t | |
| 1047 (let* ((len (length gopher-bookmarks)) | |
| 1048 (new-bookmarks (make-vector (1+ len) nil)) | |
| 1049 (pos (1- (gopher-directory-n arg))) | |
| 1050 i) | |
| 1051 | |
| 1052 (if (or (< pos 0) (> pos (length gopher-bookmarks))) | |
| 1053 (error "Out of range.")) | |
| 1054 | |
| 1055 (setq i (1- pos)) | |
| 1056 (while (>= i 0) | |
| 1057 (aset new-bookmarks i (aref gopher-bookmarks i)) | |
| 1058 (setq i (1- i))) | |
| 1059 | |
| 1060 (aset new-bookmarks pos gopher-killed-bookmark) | |
| 1061 | |
| 1062 (setq i pos) | |
| 1063 (while (< i len) | |
| 1064 (aset new-bookmarks (1+ i) (aref gopher-bookmarks i)) | |
| 1065 (setq i (1+ i))) | |
| 1066 | |
| 1067 (setq gopher-bookmarks new-bookmarks | |
| 1068 gopher-bookmarks-modified t | |
| 1069 gopher-killed-bookmark nil | |
| 1070 gopher-bookmark-modified-tick | |
| 1071 (1+ gopher-bookmark-modified-tick)) | |
| 1072 | |
| 1073 (let ((ppos (1- (gopher-directory-n nil)))) | |
| 1074 (if (<= pos ppos) | |
| 1075 (setq ppos (1+ ppos))) | |
| 1076 (gopher-format-bookmarks) | |
| 1077 (goto-char (point-min)) | |
| 1078 (forward-line ppos) | |
| 1079 (forward-char 7)) | |
| 1080 )))) | |
| 1081 | |
| 1082 | |
| 1083 (defun gopher-bookmark-directory-p () | |
| 1084 "Return T if currently displaying Bookmark directory." | |
| 1085 gopher-bookmark-directory-p) | |
| 1086 ; (equal gopher-dir gopher-bookmarks)) | |
| 1087 | |
| 1088 | |
| 1089 (defun gopher-read-lisp-bookmarks (fn) | |
| 1090 "currently unsupported" | |
| 1091 (error "gopher-read-lisp-bookmark is not yet supported. Sorry.")) | |
| 1092 | |
| 1093 (defun gopher-save-lisp-bookmarks (fn) | |
| 1094 "currently unsupported" | |
| 1095 (error "gopher-save-lisp-bookmark is not yet supported. Sorry.")) | |
| 1096 | |
| 1097 | |
| 1098 | |
| 1099 ;;;;-------------------------------------------------------------------------- | |
| 1100 ;;;; gopher documents | |
| 1101 ;;;; | |
| 1102 | |
| 1103 | |
| 1104 (defun gopher-document-object (obj oldbuf &optional end-regexp) | |
| 1105 "Retrieve and display a gopher document. | |
| 1106 Optional argument END-REGEXP is used if the data will not be ended by `.'." | |
| 1107 | |
| 1108 (let ((docbuf (gopher-get-doc-buf (gopher-object-descr obj)))) | |
| 1109 | |
| 1110 ;; Snarf the data into the buffer. | |
| 1111 (gopher-retrieve-document-cleanly (docbuf | |
| 1112 (gopher-object-selector obj) | |
| 1113 (gopher-object-host obj) | |
| 1114 (gopher-object-port obj) | |
| 1115 end-regexp) | |
| 1116 | |
| 1117 (progn | |
| 1118 (kill-buffer docbuf) | |
| 1119 (error "Problems retrieving document.")) | |
| 1120 | |
| 1121 ;; Turn on document mode and put the description in the mode line. | |
| 1122 (switch-to-buffer docbuf) | |
| 1123 (gopher-make-local-vars | |
| 1124 'gopher-obj obj | |
| 1125 'gopher-last oldbuf) | |
| 1126 (goto-char (point-min)) | |
| 1127 (gopher-document-mode) | |
| 1128 (setq mode-line-buffer-identification (concat "Gopher: " | |
| 1129 (gopher-object-descr obj))) | |
| 1130 ))) | |
| 1131 | |
| 1132 | |
| 1133 ;; keymap for document mode | |
| 1134 (suppress-keymap gopher-document-mode-map) | |
| 1135 | |
| 1136 ;Virginia Peck <vapeck@cs> Mon Aug 10 21:44:35 1992 | |
| 1137 ;;(define-key gopher-document-mode-map "\C-xk" 'gopher-last-node) | |
| 1138 | |
| 1139 (define-key gopher-document-mode-map "l" 'gopher-last-node) | |
| 1140 (define-key gopher-document-mode-map "q" 'gopher-last-node) | |
| 1141 (define-key gopher-document-mode-map "u" 'gopher-last-node) | |
| 1142 (define-key gopher-document-mode-map " " 'scroll-up) | |
| 1143 (define-key gopher-document-mode-map "\C-?" 'scroll-down) | |
| 1144 (define-key gopher-document-mode-map "\r" 'gopher-scroll-one-line-up) | |
| 1145 | |
| 1146 | |
| 1147 (defun gopher-document-mode nil | |
| 1148 "Gopher document mode. | |
| 1149 | |
| 1150 \\{gopher-document-mode-map} | |
| 1151 " | |
| 1152 (use-local-map gopher-document-mode-map) | |
| 1153 (setq major-mode 'gopher-document-mode) | |
| 1154 (setq mode-name "gopher doc") | |
| 1155 (run-hooks 'gopher-document-mode-hook) | |
| 1156 (setq buffer-read-only t)) | |
| 1157 | |
| 1158 | |
| 1159 ;; from gosmacs.el | |
| 1160 (defun gopher-scroll-one-line-up (&optional arg) | |
| 1161 "Scroll the selected window up (forward in the text) one line (or N lines)." | |
| 1162 (interactive "p") | |
| 1163 (scroll-up (or arg 1))) | |
| 1164 | |
| 1165 | |
| 1166 ;;;;-------------------------------------------------------------------------- | |
| 1167 ;;;; CSO handling. | |
| 1168 ;;;; | |
| 1169 ;;;; uses a subset of forms mode to handle data entry. | |
| 1170 ;;;; | |
| 1171 | |
| 1172 (defun gopher-cso-object (obj oldbuf) | |
| 1173 "Display a CSO lookup form." | |
| 1174 | |
| 1175 ;; The following will create a buffer displaying the form described | |
| 1176 ;; by the list in the last argument (cf. forms-mode). When the user | |
| 1177 ;; accepts the data in the form (by pressing `C-c RET'), the function | |
| 1178 ;; gopher-do-cso will be called with the data the user supplied. | |
| 1179 (gopher-form (gopher-object-descr obj) | |
| 1180 'gopher-do-cso | |
| 1181 4 | |
| 1182 '("====== phone directory lookup ======" | |
| 1183 "\n Press `C-c RET' to lookup, `C-c l' to return to the last gopher object." | |
| 1184 "\n (you must fill in at least one of the first three fields)" | |
| 1185 "\n" | |
| 1186 "Name : " 1 | |
| 1187 "\n" | |
| 1188 "Phone : " 2 | |
| 1189 "\n" | |
| 1190 "E-Mail : " 3 | |
| 1191 "\n" | |
| 1192 "Address : " 4 | |
| 1193 )) | |
| 1194 | |
| 1195 ;; Record gopher-last so gopher-last-node knows where to go. | |
| 1196 ;; Record gopher-obj so gopher-do-cso knows what server to query. | |
| 1197 (gopher-make-local-vars | |
| 1198 'gopher-last oldbuf | |
| 1199 'gopher-obj obj)) | |
| 1200 | |
| 1201 | |
| 1202 (defconst gopher-cso-fields '("name" "phone" "email" "address") | |
| 1203 "Field names to use in CSO queries.") | |
| 1204 | |
| 1205 (defun gopher-do-cso (vals) | |
| 1206 "Make a CSO query. VALS is the data the user entered in the form, | |
| 1207 as a list of strings." | |
| 1208 | |
| 1209 ;; Check that the required data was provided. | |
| 1210 (if (zerop (+ (length (nth 0 vals)) | |
| 1211 (length (nth 1 vals)) | |
| 1212 (length (nth 2 vals)))) | |
| 1213 (error "Must specify name, phone, or email.")) | |
| 1214 | |
| 1215 (let ((query "query") | |
| 1216 (fields gopher-cso-fields) | |
| 1217 (obj gopher-obj)) | |
| 1218 | |
| 1219 ;; Form the query string | |
| 1220 (while vals | |
| 1221 | |
| 1222 (if (not (zerop (length (car vals)))) | |
| 1223 (setq query (concat query " " (car fields) "=" (car vals)))) | |
| 1224 | |
| 1225 (setq vals (cdr vals)) | |
| 1226 (setq fields (cdr fields))) | |
| 1227 | |
| 1228 ;; Use this string as the object selector. | |
| 1229 (gopher-set-object-selector gopher-obj query) | |
| 1230 | |
| 1231 ;; Retrieve the data from the server. Unlike gopher, the CSO data | |
| 1232 ;; does not use `.' as a terminator. | |
| 1233 (gopher-document-object gopher-obj (current-buffer) "^[2-9]") | |
| 1234 | |
| 1235 ;; Strip CSO control information from the buffer. | |
| 1236 (gopher-clean-cso-buffer obj))) | |
| 1237 | |
| 1238 | |
| 1239 (defun gopher-clean-cso-buffer (obj) | |
| 1240 "Strip CSO control information from the current buffer." | |
| 1241 | |
| 1242 (let ((req "") | |
| 1243 (buffer-read-only nil) | |
| 1244 beg nreq) | |
| 1245 (goto-char (point-min)) | |
| 1246 (insert "\n") | |
| 1247 (while (not (eobp)) | |
| 1248 (cond ((and (>= (following-char) ?3) (<= (following-char) ?9)) | |
| 1249 (delete-char 4) | |
| 1250 (insert (concat (gopher-object-selector obj) "\n"))) | |
| 1251 | |
| 1252 ((eq (following-char) ?-) | |
| 1253 (delete-char 5) | |
| 1254 (setq beg (point)) | |
| 1255 (skip-chars-forward "^:") | |
| 1256 (setq nreq (buffer-substring beg (point))) | |
| 1257 (goto-char beg) | |
| 1258 (or (string= req nreq) | |
| 1259 (insert (concat "--------------------------" | |
| 1260 "-----------------------------\n"))) | |
| 1261 (setq req nreq) | |
| 1262 (setq beg (point)) | |
| 1263 (skip-chars-forward "^:") | |
| 1264 (forward-char) | |
| 1265 (delete-region beg (point))) | |
| 1266 | |
| 1267 (t | |
| 1268 (setq beg (point)) | |
| 1269 (forward-line 1) | |
| 1270 (delete-region beg (point)) | |
| 1271 (forward-line -1)) | |
| 1272 ) | |
| 1273 (forward-line 1)) | |
| 1274 | |
| 1275 (goto-char (point-min)) | |
| 1276 (delete-char 1))) | |
| 1277 | |
| 1278 | |
| 1279 ;;;;-------------------------------------------------------------------------- | |
| 1280 ;;;; indices. | |
| 1281 ;;;; | |
| 1282 ;;;; To query an index, the search string is appended to the selector. | |
| 1283 ;;;; The index returns a gopher directory. | |
| 1284 ;;;; | |
| 1285 | |
| 1286 | |
| 1287 (defun gopher-index-object (obj oldbuf) | |
| 1288 "Query a gopher directory object." | |
| 1289 | |
| 1290 ;; Get the search string from the user. | |
| 1291 (let ((str (read-from-minibuffer "Key: ")) | |
| 1292 (newobj (copy-sequence obj))) | |
| 1293 | |
| 1294 ;; Append it to the selector and retrieve the modified object | |
| 1295 ;; like a directory. | |
| 1296 (setq str (gopher-trim-blanks str)) | |
| 1297 (if (> (length str) 0) | |
| 1298 (progn | |
| 1299 (gopher-set-object-selector newobj | |
| 1300 (concat (gopher-object-selector obj) "\t" | |
| 1301 str)) | |
| 1302 (gopher-directory-object newobj (current-buffer))) | |
| 1303 ))) | |
| 1304 | |
| 1305 | |
| 1306 | |
| 1307 ;;;;-------------------------------------------------------------------------- | |
| 1308 ;;;; telneting. | |
| 1309 ;;;; | |
| 1310 | |
| 1311 (defun gopher-telnet-object (obj oldbuf) | |
| 1312 "Start a telnet session to a gopher object. | |
| 1313 If gopher-telnet-command is nonnil, then that is a command to start | |
| 1314 a telnet session in a subprocess. Otherwise, the emacs-lisp telnet | |
| 1315 package is used." | |
| 1316 | |
| 1317 ;; make the telnet argument string | |
| 1318 (let ((arg (gopher-object-host obj)) | |
| 1319 (port (gopher-object-port obj))) | |
| 1320 (if (not (zerop port)) | |
| 1321 (setq arg (concat arg | |
| 1322 (if (eq system-type 'vax-vms) | |
| 1323 "/port=" | |
| 1324 " ") | |
| 1325 port))) | |
| 1326 | |
| 1327 (if gopher-telnet-command | |
| 1328 | |
| 1329 ;; start up telnet as a separate process | |
| 1330 (save-window-excursion | |
| 1331 (gopher-background | |
| 1332 (concat gopher-telnet-command " " arg))) | |
| 1333 | |
| 1334 ;; use telnet-mode | |
| 1335 (telnet arg) | |
| 1336 ;; set things up so we can get back to the last node. | |
| 1337 (gopher-make-local-vars | |
| 1338 'gopher-obj obj | |
| 1339 'gopher-last oldbuf | |
| 1340 'gopher-telnet-process-name (concat arg "-telnet")) | |
| 1341 (local-set-key "\C-cl" 'gopher-telnet-quit) | |
| 1342 (local-set-key "\C-xk" 'gopher-telnet-quit) | |
| 1343 ) | |
| 1344 | |
| 1345 ;; show the login info to the user | |
| 1346 (if (not (zerop (length (gopher-object-selector obj)))) | |
| 1347 (progn | |
| 1348 (beep) | |
| 1349 (message (concat | |
| 1350 "Login as: " | |
| 1351 (gopher-object-selector obj) | |
| 1352 )) | |
| 1353 )) | |
| 1354 )) | |
| 1355 | |
| 1356 | |
| 1357 (defun gopher-telnet-quit nil | |
| 1358 "Clean up a telnet session and return to the previous gopher node." | |
| 1359 (interactive) | |
| 1360 (condition-case nil | |
| 1361 (delete-process gopher-telnet-process-name) | |
| 1362 (error t)) | |
| 1363 (gopher-last-node)) | |
| 1364 | |
| 1365 | |
| 1366 | |
| 1367 ;;;;-------------------------------------------------------------------------- | |
| 1368 ;;;; Images/sounds. | |
| 1369 ;;;; | |
| 1370 | |
| 1371 (defun gopher-image-object (obj oldbuf) | |
| 1372 "Retrieve what we hope is an image and show it." | |
| 1373 (let ( | |
| 1374 (showit (y-or-n-p "Display this item? ")) | |
| 1375 (fname) | |
| 1376 (buf (gopher-get-doc-buf (gopher-object-descr obj)))) | |
| 1377 (if showit | |
| 1378 (setq fname (make-temp-name "/tmp/gopherimg")) | |
| 1379 (setq fname(read-file-name "File to save in: "))) | |
| 1380 (gopher-retrieve-document-cleanly (buf | |
| 1381 (gopher-object-selector obj) | |
| 1382 (gopher-object-host obj) | |
| 1383 (gopher-object-port obj) | |
| 1384 'none) | |
| 1385 (progn | |
| 1386 (error "Problems retrieving object.") | |
| 1387 (kill-buffer buf)) | |
| 1388 | |
| 1389 (save-excursion | |
| 1390 (set-buffer buf) | |
| 1391 (write-file fname)) | |
| 1392 (kill-buffer buf) | |
| 1393 (if (and showit gopher-image-display-command) | |
| 1394 | |
| 1395 ;; Spawn a process to display the image. | |
| 1396 ;; But modify its sentinel so that the file we wrote | |
| 1397 ;; will get deleted when the process exits. | |
| 1398 (save-window-excursion | |
| 1399 (let ((p (gopher-background | |
| 1400 (concat gopher-image-display-command " " fname)))) | |
| 1401 (set-process-sentinel p | |
| 1402 (` (lambda (process msg) | |
| 1403 ((, (process-sentinel p)) process msg) | |
| 1404 (if (not (eq (process-status process) 'run)) | |
| 1405 (delete-file (, fname))) | |
| 1406 ))) | |
| 1407 )) | |
| 1408 )))) | |
| 1409 | |
| 1410 | |
| 1411 | |
| 1412 ;;;;-------------------------------------------------------------------------- | |
| 1413 ;;;; Various opaque objects. Just save them in a file for now. | |
| 1414 ;;;; | |
| 1415 | |
| 1416 (defun gopher-binary-object (obj oldbuf) | |
| 1417 "Retrieve a gopher object and save it to a file, | |
| 1418 without trying to interpret it in any way." | |
| 1419 (let ((fname (read-file-name "File to save in: ")) | |
| 1420 (buf (gopher-get-doc-buf (gopher-object-descr obj)))) | |
| 1421 | |
| 1422 (gopher-retrieve-document-cleanly (buf | |
| 1423 (gopher-object-selector obj) | |
| 1424 (gopher-object-host obj) | |
| 1425 (gopher-object-port obj) | |
| 1426 'none) | |
| 1427 | |
| 1428 (progn | |
| 1429 (error "Problems retrieving object.") | |
| 1430 (kill-buffer buf)) | |
| 1431 | |
| 1432 (save-excursion | |
| 1433 (set-buffer buf) | |
| 1434 (write-file fname)) | |
| 1435 (kill-buffer buf) | |
| 1436 ))) | |
| 1437 | |
| 1438 | |
| 1439 ;;;;-------------------------------------------------------------------------- | |
| 1440 ;;;; forms stuff | |
| 1441 ;;;; | |
| 1442 ;;;; Uses some of the internal routines from forms.el to present | |
| 1443 ;;;; a form which is not associated with a file. | |
| 1444 ;;;; | |
| 1445 | |
| 1446 (defun gopher-form (form-name accept-action number-of-fields format-list) | |
| 1447 "Display a buffer containing a form for the user to enter data. | |
| 1448 The form is described by NUMBER-OF-FIELDS and FORMAT-LIST (cf. forms-mode). | |
| 1449 FORM-NAME is a string to put in the modeline. | |
| 1450 When the user accepts the data in the form by pressing `C-c RET', the | |
| 1451 function ACCEPT-ACTION is called with a list of the strings which | |
| 1452 the user entered." | |
| 1453 | |
| 1454 (switch-to-buffer (generate-new-buffer "*gopher form*")) | |
| 1455 | |
| 1456 (gopher-make-local-vars | |
| 1457 'forms-format-list format-list | |
| 1458 'forms-number-of-fields number-of-fields | |
| 1459 'forms-field-sep "\t" | |
| 1460 'forms-read-only nil | |
| 1461 'forms-multi-line nil | |
| 1462 'forms--number-of-markers nil | |
| 1463 'forms--markers nil | |
| 1464 'forms--format nil | |
| 1465 'forms--parser nil | |
| 1466 'forms--dynamic-text nil | |
| 1467 'forms-fields nil | |
| 1468 'forms-the-record-list nil | |
| 1469 'forms-accept-action accept-action | |
| 1470 ) | |
| 1471 | |
| 1472 (forms--process-format-list) | |
| 1473 (forms--make-format) | |
| 1474 (forms--make-parser) | |
| 1475 | |
| 1476 (erase-buffer) | |
| 1477 | |
| 1478 ;; make local variables | |
| 1479 (make-local-variable 'forms--file-buffer) | |
| 1480 (make-local-variable 'forms--total-records) | |
| 1481 (make-local-variable 'forms--current-record) | |
| 1482 (make-local-variable 'forms--the-record-list) | |
| 1483 (make-local-variable 'forms--search-rexexp) | |
| 1484 | |
| 1485 ;; set the major mode indicator | |
| 1486 (setq major-mode 'gopher-form-mode) | |
| 1487 (setq mode-name "gopher form") | |
| 1488 | |
| 1489 (set-buffer-modified-p nil) | |
| 1490 | |
| 1491 (use-local-map gopher-form-mode-map) | |
| 1492 | |
| 1493 (forms--show-record (make-string (1- number-of-fields) ?\t)) | |
| 1494 | |
| 1495 (run-hooks 'gopher-form-mode-hooks)) | |
| 1496 | |
| 1497 | |
| 1498 (defun gopher-form-accept nil | |
| 1499 (interactive) | |
| 1500 | |
| 1501 (funcall forms-accept-action (forms--parse-form))) | |
| 1502 | |
| 1503 (define-key gopher-form-mode-map "\C-c\r" 'gopher-form-accept) | |
| 1504 (define-key gopher-form-mode-map "\C-cl" 'gopher-last-node) | |
| 1505 | |
| 1506 | |
| 1507 ;;;;-------------------------------------------------------------------------- | |
| 1508 ;;;; low-level communications routines | |
| 1509 ;;;; | |
| 1510 | |
| 1511 | |
| 1512 (defun gopher-retrieve-document (buf sel host port &optional end-regexp) | |
| 1513 "Retrieve a gopher object into BUF. | |
| 1514 The object is identified by a SEL HOST PORT triple. | |
| 1515 Optional argument END-REGEXP is used for data which is not `.'-terminated. | |
| 1516 If END-REGEXP is non-nil and not a string, then it is assumed that | |
| 1517 the data is binary, and reading will continue until the sender disconnects. | |
| 1518 Returns NIL if an error occured during the attempt to retrieve the | |
| 1519 document, otherwise T. | |
| 1520 " | |
| 1521 | |
| 1522 ;; Default is single period termination. | |
| 1523 (or end-regexp (setq end-regexp "^\\.\r$")) | |
| 1524 | |
| 1525 (save-excursion | |
| 1526 (set-buffer buf) | |
| 1527 (erase-buffer) | |
| 1528 | |
| 1529 (let ((h (assoc host gopher-hostname-aliases))) | |
| 1530 (if h (setq host (cdr h)))) | |
| 1531 | |
| 1532 ;; Open the connection to the server. | |
| 1533 ;; If we get an unknown service error, try looking the port up in | |
| 1534 ;; gopher-port-aliases. If we find it there, try the connect again | |
| 1535 ;; with that translation. | |
| 1536 (let (wait | |
| 1537 (gopher-server-process | |
| 1538 (let (p (try-again t)) | |
| 1539 (while try-again | |
| 1540 (setq try-again nil) | |
| 1541 (condition-case errinfo | |
| 1542 (setq p (open-network-stream "gopher" (current-buffer) | |
| 1543 host port)) | |
| 1544 (error (if (and (string-match "^Unknown service .*$" | |
| 1545 (nth 1 errinfo)) | |
| 1546 (setq port (cdr (assoc port | |
| 1547 gopher-port-aliases)))) | |
| 1548 (setq try-again t) | |
| 1549 (ding) | |
| 1550 (message (format "%s: %s" | |
| 1551 (nth 0 errinfo) | |
| 1552 (nth 1 errinfo))) | |
| 1553 )))) | |
| 1554 p))) | |
| 1555 | |
| 1556 (cond (gopher-server-process | |
| 1557 | |
| 1558 ;; keep the emacs end-of-process status line out of the buffer | |
| 1559 (set-process-sentinel gopher-server-process 'gopher-sentinel) | |
| 1560 | |
| 1561 ;; send the selector to the server | |
| 1562 (process-send-string gopher-server-process (concat sel "\r\n")) | |
| 1563 | |
| 1564 ;; receive the response from the server | |
| 1565 ;; based on nntp.el from GNUS | |
| 1566 (setq wait t) | |
| 1567 (while wait | |
| 1568 (if (stringp end-regexp) | |
| 1569 (progn | |
| 1570 (goto-char (point-max)) | |
| 1571 (forward-line -1))) | |
| 1572 (if (and (stringp end-regexp) | |
| 1573 (looking-at end-regexp)) | |
| 1574 (setq wait nil) | |
| 1575 (if (not (memq (process-status gopher-server-process) | |
| 1576 '(open run))) | |
| 1577 (progn | |
| 1578 (message "gopher: connection closed") | |
| 1579 (setq wait nil)) | |
| 1580 (if gopher-debug-read | |
| 1581 (message "gopher: Reading...")) | |
| 1582 (cond (gopher-buggy-accept | |
| 1583 (sit-for 1)) | |
| 1584 ((and (boundp 'epoch::version) epoch::version) | |
| 1585 (accept-process-output gopher-server-process 2)) | |
| 1586 (t | |
| 1587 (accept-process-output gopher-server-process)) | |
| 1588 ) | |
| 1589 (if gopher-debug-read | |
| 1590 (message " "))) | |
| 1591 )) | |
| 1592 | |
| 1593 ;; be sure the net connection has gone away... | |
| 1594 (condition-case nil | |
| 1595 (delete-process gopher-server-process) | |
| 1596 (error t)) | |
| 1597 | |
| 1598 ;; clean up the text buffer | |
| 1599 (if (stringp end-regexp) | |
| 1600 (gopher-clean-text)) | |
| 1601 | |
| 1602 t) | |
| 1603 | |
| 1604 (t nil)) | |
| 1605 ))) | |
| 1606 | |
| 1607 | |
| 1608 ;;; adapted from GNUS | |
| 1609 (defun gopher-clean-text () | |
| 1610 "Decode text transmitted by gopher. | |
| 1611 0. Delete status line. | |
| 1612 1. Delete `^M' at end of line. | |
| 1613 2. Delete `.' at end of buffer (end of text mark). | |
| 1614 3. Delete `.' at beginning of line. (does gopher want this?)" | |
| 1615 | |
| 1616 ;; Insert newline at end of buffer. | |
| 1617 (goto-char (point-max)) | |
| 1618 (if (not (bolp)) | |
| 1619 (insert "\n")) | |
| 1620 ;; Delete `^M' at end of line. | |
| 1621 (goto-char (point-min)) | |
| 1622 (while (re-search-forward "\r[^\n]*$" nil t) | |
| 1623 (replace-match "")) | |
| 1624 ; (goto-char (point-min)) | |
| 1625 ; (while (not (eobp)) | |
| 1626 ; (end-of-line) | |
| 1627 ; (if (= (preceding-char) ?\r) | |
| 1628 ; (delete-char -1)) | |
| 1629 ; (forward-line 1) | |
| 1630 ; ) | |
| 1631 ;; Delete `.' at end of buffer (end of text mark). | |
| 1632 (goto-char (point-max)) | |
| 1633 (forward-line -1) ;(beginning-of-line) | |
| 1634 (while (looking-at "^\\.$") | |
| 1635 (delete-region (point) (progn (forward-line 1) (point))) | |
| 1636 (forward-line -1)) | |
| 1637 ;; Replace `..' at beginning of line with `.'. | |
| 1638 (goto-char (point-min)) | |
| 1639 ;; (replace-regexp "^\\.\\." ".") | |
| 1640 (while (search-forward "\n.." nil t) | |
| 1641 (delete-char -1)) | |
| 1642 ) | |
| 1643 | |
| 1644 | |
| 1645 (defun gopher-sentinel (proc status) | |
| 1646 nil) | |
| 1647 | |
| 1648 (provide 'gopher) | |
| 1649 | |
| 1650 ;;; gopher.el ends here | |
| 1651 | |
| 1652 ;;;(gopher.el) Local Variables: | |
| 1653 ;;;(gopher.el) eval: (put 'gopher-retrieve-document-cleanly 'lisp-indent-hook 2) | |
| 1654 ;;;(gopher.el) End: | |
| 1655 |