;;; ell.el --- Browse the Emacs Lisp List ;; Author: Jean-Philippe Theberge ([email protected]) ;; Stephen Eglen ([email protected]) ;; Nascif A. Abousalh Neto ([email protected]) ;; Created: 2000-05-22 - last update: Mon 14 Aug 2006 ;; Version: 1.1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Copyright (c) 1998 - 1999 Free Software Foundation, Inc. ;; ;; Ell.el is free software; you can redistribute it and/or modify it ;; under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; ;; Ell.el is distributed in the hope that it will be useful, but ;; WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;; General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Commentary: ;; ;; The Emacs Lisp Lisp is available at ;; http://www.damtp.cam.ac.uk/user/sje30/emacs/ell.html ;; ;; If Stephen changes the layout of his web page, this package may ;; stop to work correctly. You may then need to upgrade this ;; package. ;; After loading this file, just do "M-x ell-packages" to view the ;; list in its own buffer. ;; Use a prefix argument (i.e. "C-u M-x ell-packages") to sort by ;; author name. ;; (New in 1.1) ;; Retrieves information from ell.xml instead of ell.html. Old method relied on ;; regular expressions for parsing and was skipping some entries. ;; (New in 1.0) ;; Packages added to the ELL since the last time you called ;; "ell-packages" will be marked with a tag (""). This is ;; achieved by storing relevant information about the last time you ;; accessed ELL in a file. If you delete this file, the next time you ;; access the ELL, all files will be marked as new once more. If ;; ell-occur-if-new-found is t, an *Occur* buffer will automatically ;; show you the new entries. ;; ;; The elib package is required for cache management (using the ;; avltree facility). If you do not have elib, get it from any GNU ;; mirror, such as ;; ftp://wuarchive.wustl.edu/systems/gnu/emacs/elib-1.0.tar.gz ;; ;; Variables. ;; ;; Set ell-locate to t (default nil) if you want emacs to ;; indicate which lisp files are already available on your system. ;; ;; Set ell-goto-addr to t (default nil) if you want to turn the ;; URLs into hyperlinks using the goto-addr package. ;; ;; Set ell-last-read-filename to the name of the file where you want ;; to store information from the last time the ELL site was accessed. ;; To Do: ;; ;; + Do the http fetching in the background so emacs is not ;; freezed on slow connections ;; ;; + Take consideration for the accented character in the sort by ;; author. ;; ;; + replace sort* with something else so the need for cl.el is ;; no more required. (is this really necessary?) ;; ;; + Highlight packages already somewhere on your local lisp path. ;;; Code: (require 'cl) ;needed for `sort*' routine. (require 'avltree) ;from elib, needed for cache management (require 'xml) ;needed for `sort*' routine. (defvar ell-host "www.damtp.cam.ac.uk") (defvar ell-path "user/sje30/emacs/ell.xml") (defvar ell-proxy-host nil "*If nil dont use proxy, else name of proxy server.") (defvar ell-proxy-port nil "*Port number of proxy server. Default is 80.") (defvar ell-locate nil "*Non-nil if we want to test whether package is available on local system. This will considerably slow down viewing of this buffer.") (defvar ell-occur-if-new-found t "*Non-nil if we want to activate an *Occur* buffer listing new packages.") (defvar ell-goto-addr nil "*Non-nil if we want to use turn URLs into hyperlinks. If nil, you may want to use another package, such as ffap, instead. \(This feature may not be available in XEmacs.)") (defvar ell-last-updated nil "Date that the list was last updated.") (defvar ell-use-font-lock t "*If non-nil, we font-lock the ELL buffer.") (defvar ell-last-read-filename "~/.ell-last-read" "File where information about the last known state of the ELL is stored.") (if ell-goto-addr (require 'goto-addr)) (defun ell-read-from-file (filename) "Read a generic Lisp object from FILENAME." (if (file-readable-p filename) (with-temp-buffer (insert-file-contents-literally filename) (read (current-buffer))))) (defun ell-new-cache () "Create a new cache entry." (avltree-create (lambda (package1 package2) (and (string< (car package1) (car package2)) (string< (cdr package1) (cdr package2)))))) (defun ell-read-cache-from-file (filename) "Return a package cache from FILENAME, or a new one if none was found." (let ((previous-cache (ell-read-from-file filename))) (if (or (null previous-cache) (not (avltree-p previous-cache))) (ell-new-cache) previous-cache))) (defun ell-write-to-file (object filename) "Writes a generic Lisp OBJECT to FILENAME." (if (file-writable-p filename) (with-temp-file filename (print object (current-buffer))))) (defun ell-write-cache-to-file (new-cache) "Write NEW-CACHE cache to disk, created from the HTML page we just read." (ell-write-to-file new-cache ell-last-read-filename) ) ;; defvars to keep the byte compiler quiet. (defvar ell-ref1) (defvar ell-msg) (defvar ell-dstr) (defvar ell-font-lock-keywords) (eval-and-compile (condition-case nil (require 'working) (error (progn (defmacro working-status-forms (message donestr &rest forms) "Contain a block of code during which a working status is shown." (list 'let (list (list 'ell-msg message) (list 'ell-dstr donestr) '(ell-ref1 0)) (cons 'progn forms))) (defun working-status (&optional percent &rest args) "Called within the macro `working-status-forms', show the status." (message "%s%s" (apply 'format ell-msg args) (if (eq percent t) (concat "... " ell-dstr) (format "... %3d%%" (or percent (floor (* 100.0 (/ (float (point)) (point-max))))))))) (defun working-dynamic-status (&optional number &rest args) "Called within the macro `working-status-forms', show the status." (message "%s%s" (apply 'format ell-msg args) (format "... %c" (aref [ ?- ?/ ?| ?\\ ] (% ell-ref1 4)))) (setq ell-ref1 (1+ ell-ref1))) (put 'working-status-forms 'lisp-indent-function 2))))) (defun ell-packages-list (&optional byauthor) "Insert the contents of URL at point. Optional argument BYAUTHOR determines whether we should sort by author." (if (get-buffer "*ell-temp-buffer*") (kill-buffer "*ell-temp-buffer*")) (with-temp-buffer (let* ((host ell-host) (path ell-path) (coding-system-for-read 'binary) (coding-system-for-write 'binary) (http (open-network-stream "ell-retrieval-process" "*ell-temp-buffer*" (if ell-proxy-host ell-proxy-host host) (if ell-proxy-port ell-proxy-port 80))) (pbuf (process-buffer http))) (process-send-string http (concat "GET " (if ell-proxy-host (concat "http://" ell-host "/") "/") path " HTTP/1.0\r\n\r\n")) (working-status-forms "Retrieving ell.xml" "done" (while (eq (process-status http) 'open) (working-dynamic-status nil) ;;(working-dynamic-status (buffer-size pbuf)) (sleep-for 1) )) (insert-buffer-substring pbuf) (kill-buffer pbuf) (ell-build-packages-list)))) (defun ell-build-packages-list () "parses the contents of the current buffer, which is expected to contain the downloaded contents of the ELL site ell.xml file" (ell-fix-for-xml-parser-bug) (goto-char (point-min)) (let* ((xml (xml-parse-region (point-min) (point-max) (current-buffer))) (ell-root (car xml)) (ell-entries (cadddr ell-root))) (setq ell-last-updated (nth 2 (caddr ell-root))) (mapcar '(lambda (entry) (let ((attrs (cadr entry))) (list (cdr (assoc 'site attrs)) (cdr (assoc 'filename attrs)) (cdr (assoc 'description attrs)) (cdr (assoc 'contact attrs)) ))) (cddr ell-entries)))) (defun ell-sort-by-author (packagesL) "Auxiliary routine to sort PACKAGESL by author." (sort* (mapcar (lambda (x) (let ((authorl (split-string (car (last x))))) (list (car x)(cadr x)(caddr x)(cadddr x)(car (last authorl))))) packagesL) 'string-lessp :key #'(lambda (x) (car (last x))))) (define-derived-mode ell-mode view-mode "Ell" "Major mode to display the Emacs lisp list. Special commands: \\{ellmode-map}" (if ell-use-font-lock (progn (setq ell-font-lock-keywords (list '(" " 0 font-lock-warning-face) '("^\\(.*\\.el\\) " 1 font-lock-keyword-face) '("^\\(ht\\|f\\)tp.*$" . font-lock-comment-face) ) ) (make-local-variable 'font-lock-defaults) (setq font-lock-defaults '(ell-font-lock-keywords nil t))) )) (defun ell-prepare-buffer () "Prepare to make the new *ell-packages* buffer." (if (get-buffer "*ell-packages*") (kill-buffer "*ell-packages*")) (switch-to-buffer "*ell-packages*") (insert "==========================================") (center-line)(insert "\n") (insert "The Emacs Lisp List")(center-line)(insert "\n") (insert "by Stephen Eglen: [email protected]")(center-line)(insert "\n") (insert "==========================================") (center-line)(insert "\n\n") ) (defun ell-update-buffer (ell-last-updated new-count) "Update the counters at the top of the *ell-packages* buffer. ELL-LAST-UPDATED is the date when ELL was last updated. NEW-COUNT is the number of new entries." (if ell-last-updated (progn (goto-line 4) ;naughty... (insert (concat "Last updated: " ell-last-updated "\n")) (forward-line -1) (center-line))) (if (> new-count 0) (progn (goto-line 4) ;ditto... (insert (format "Number of new entries: %d\n" new-count)) (forward-line -1) (center-line))) ) ;;;###autoload (defun ell-packages (byauthor) "Display the Emacs Lisp list in a Emacs buffer. If BYAUTHOR is true, we sort the list by author name." (interactive "P") (let ((packagesL (ell-packages-list)) (cache (ell-read-cache-from-file ell-last-read-filename)) (new-cache (ell-new-cache)) (new-count 0)) (ell-prepare-buffer) (if ell-locate (insert "Note: Files with an asterisk (*) \ are already installed on your system.\n\n")) (mapcar (lambda (x) ;; name - description - (by author) ;; URL (let* ((url (car x)) (name (cadr x)) (description (car (cdr (cdr x)))) (author (car (cdr (cdr (cdr x))))) (package (cons name author))) (avltree-enter new-cache package) (insert (format "%s %s- %s (by %s)\n%s\n\n" (if (and ell-locate (locate-library name)) (concat "*" name) name) (if (avltree-member cache package) "" (progn (setq new-count (1+ new-count)) " ")) description author url)))) (if byauthor (ell-sort-by-author packagesL) ;; (reverse packagesL))) packagesL)) (ell-write-cache-to-file new-cache) (ell-update-buffer ell-last-updated new-count) (ell-mode) (if ell-goto-addr ;; ELL is a big file, so ensure the maximum size for fontifying ;; addresses is okay. (progn (set (make-local-variable 'goto-address-fontify-maximum-size) (+ 10 (buffer-size))) (goto-address))) (goto-char (point-min)) (if ell-use-font-lock (font-lock-fontify-buffer)) (if (and ell-occur-if-new-found (> new-count 0)) (occur "")))) (defun ell-fix-for-xml-parser-bug () "current version of xml.el can't deal with empty strings. Not a problem for us, so let's just remove them" (goto-char (point-min)) (while (search-forward "note=\"\"" nil t) (replace-match "" nil t)) ) (provide 'ell) ;;; ell.el ends here