(nnshimbun-make-shimbun-header): Use the following macros.
(nnshimbun-mail-header-from): New macro whose definition will be changed
statically for Gnus or gnus.
(nnshimbun-mail-header-subject): Ditto.
(TopLevel): Don't require `gnus-clfns'.
* gnus.el: Add autoload for `find-cl-run-time-functions'.
* gnus-clfns.el (find-cl-run-time-functions): New command for the developers.
(cl-run-time-functions): New variable.
(TopLevel): Don't require `cl' at run-time.
+2001-05-29 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * lisp/nnshimbun.el (nnshimbun-retrieve-headers-with-nov): Don't
+ use `last'.
+ (nnshimbun-make-shimbun-header): Use the following macros.
+ (nnshimbun-mail-header-from): New macro whose definition will be
+ changed statically for Gnus or gnus.
+ (nnshimbun-mail-header-subject): Ditto.
+ (TopLevel): Don't require `gnus-clfns'.
+
+ * lisp/gnus.el: Add autoload for `find-cl-run-time-functions'.
+
+ * lisp/gnus-clfns.el (find-cl-run-time-functions): New command for
+ the developers.
+ (cl-run-time-functions): New variable.
+ (TopLevel): Don't require `cl' at run-time.
+
2001-05-28 TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>
* texi/gnus-ja.texi (Web Newspaper): Updated.
(if (featurep 'xemacs)
nil
- (require 'cl)
+ (eval-when-compile (require 'cl))
(require 'pym)
(define-compiler-macro butlast (&whole form x &optional n)
res)))))))))
)
+;; A tool for the developers.
+
+(defvar cl-run-time-functions
+ '(Values
+ Values-list acons assoc-if assoc-if-not build-klist butlast ceiling*
+ coerce common-lisp-indent-function compiler-macroexpand concatenate
+ copy-list count count-if count-if-not delete* delete-duplicates delete-if
+ delete-if-not duplicate-symbols-p elt-satisfies-test-p equalp evenp every
+ extract-from-klist fill find find-if find-if-not floatp-safe floor* gcd
+ gensym gentemp get-setf-method getf hash-table-count hash-table-p
+ intersection isqrt keyword-argument-supplied-p keyword-of keywordp last
+ lcm ldiff lisp-indent-259 lisp-indent-do lisp-indent-function-lambda-hack
+ lisp-indent-report-bad-format lisp-indent-tagbody list-length
+ make-hash-table make-random-state map mapc mapcan mapcar* mapcon mapl
+ maplist member-if member-if-not merge mismatch mod* nbutlast nintersection
+ notany notevery nreconc nset-difference nset-exclusive-or nsublis nsubst
+ nsubst-if nsubst-if-not nsubstitute nsubstitute-if nsubstitute-if-not
+ nunion oddp pair-with-newsyms pairlis position position-if position-if-not
+ proclaim random* random-state-p rassoc* rassoc-if rassoc-if-not
+ reassemble-argslists reduce rem* remove remove* remove-duplicates
+ remove-if remove-if-not remq replace revappend round* safe-idiv search
+ set-difference set-exclusive-or setelt setnth setnthcdr signum some sort*
+ stable-sort sublis subseq subsetp subst subst-if subst-if-not substitute
+ substitute-if substitute-if-not tailp tree-equal truncate* union
+ unzip-lists zip-lists)
+ "A list of CL run-time functions. Some functions were built-in, nowadays.")
+
+;;;###autoload
+(defun find-cl-run-time-functions (file-or-directory in-this-emacs)
+ "Find CL run-time functions in the FILE-OR-DIRECTORY. If the optional
+IN-THIS-EMACS is non-nil, the built-in functions in this emacs will
+not be reported."
+ (interactive (list (read-file-name "Find CL run-time functions in: "
+ nil default-directory t)
+ current-prefix-arg))
+ (unless (interactive-p)
+ (error "You should invoke `M-x find-cl-run-time-functions' interactively"))
+ (let (files clfns working file forms fns pt lines form fn buffer
+ buffer-file-format format-alist
+ insert-file-contents-post-hook insert-file-contents-pre-hook
+ jam-zcat-filename-list jka-compr-compression-info-list)
+ (cond ((file-directory-p file-or-directory)
+ (prog1
+ (setq files (directory-files file-or-directory t "\\.el$"))
+ (unless files
+ (message "No files found in: %s" file-or-directory))))
+ ((file-exists-p file-or-directory)
+ (setq files (list file-or-directory)))
+ (t
+ (message "No such file or directory: %s" file-or-directory)))
+ (if files
+ (progn
+ (if in-this-emacs
+ (dolist (fn cl-run-time-functions)
+ (unless (and (fboundp fn)
+ (subrp (symbol-function fn)))
+ (push fn clfns)))
+ (setq clfns cl-run-time-functions))
+ (set-buffer (setq working
+ (get-buffer-create
+ " *Searching for CL run-time functions*")))
+ (let (emacs-lisp-mode-hook)
+ (emacs-lisp-mode))
+ (while files
+ (setq file (pop files)
+ lines (list nil 1))
+ (message "Searching for CL run-time functions in: %s..."
+ (file-name-nondirectory file))
+ (insert-file-contents file nil nil nil t)
+ ;; Why is the following needed for FSF Emacsen???
+ (goto-char (point-min))
+ ;;
+ (while (setq forms (condition-case nil
+ (list (read working))
+ (error)))
+ (setq fns nil
+ pt (point)
+ lines (list (cadr lines) (count-lines (point-min) pt)))
+ (condition-case nil
+ (progn
+ (forward-list -1)
+ (setcar lines (+ (count-lines (point-min) (point))
+ (if (bolp) 1 0))))
+ (error))
+ (goto-char pt)
+ (while forms
+ (setq form (pop forms)
+ fn (pop form))
+ (cond ((eq fn 'define-compiler-macro)
+ (setq form nil))
+ ((memq fn '(let let*))
+ (setq form (append
+ (delq nil
+ (mapcar
+ (lambda (element)
+ (when (and (consp element)
+ (consp (cadr element)))
+ (cadr element)))
+ (car form)))
+ (cdr form))))
+ ((memq fn '(defadvice
+ defmacro defsubst defun defmacro-maybe
+ defmacro-maybe-cond defsubst-maybe
+ defun-maybe defun-maybe-cond))
+ (setq form (cddr form)))
+ ((eq fn 'lambda)
+ (setq form (cdr form)))
+ ((memq fn '(\` backquote quote))
+ (setq form (when (consp (car form))
+ (car form))))
+ ((and (memq fn clfns)
+ (listp form))
+ (push fn fns)))
+ (when (and (consp form)
+ (condition-case nil
+ ;; Ignore a case `(a b .c)'.
+ (length form)
+ (error nil)))
+ (setq forms (append (delq nil
+ (mapcar
+ (lambda (element)
+ (when (consp element)
+ element))
+ form))
+ forms))))
+ (when fns
+ (if buffer
+ (set-buffer buffer)
+ (display-buffer
+ (setq buffer (get-buffer-create
+ (concat "*CL run-time functions in: "
+ file-or-directory "*"))))
+ (set-buffer buffer)
+ (erase-buffer))
+ (when file
+ (insert file "\n")
+ (setq file nil))
+ (insert (format "%5d - %5d: %s"
+ (car lines) (cadr lines)
+ (mapconcat 'symbol-name
+ (nreverse fns) " ")))
+ (while (> (current-column) 78)
+ (skip-chars-backward "^ ")
+ (backward-char 1)
+ (insert "\n ")
+ (end-of-line))
+ (insert "\n")
+ (sit-for 0)
+ (set-buffer working))))
+ (kill-buffer working)
+ (if buffer
+ (message "Done")
+ (message "No CL run-time functions found in: %s"
+ file-or-directory)))
+ (message "No files found"))))
+
(provide 'gnus-clfns)
;;; gnus-clfns.el ends here
(subrp (symbol-function 'base64-encode-string)))
(require 'base64))
+;; A tool for the developers.
+(autoload 'find-cl-run-time-functions "gnus-clfns" nil t)
+
;;; gnus-sum.el thingies
;;; Commentary:
-;; Gnus backend to read newspapers on WEB.
+;; Gnus (or gnus) backend to read newspapers on the World Wide Web.
+;; This module requires the Emacs-W3M and the external command W3M.
+;; Visit the following pages for more information.
+;;
+;; http://namazu.org/~tsuchiya/emacs-w3m/
+;; http://ei5nazha.yz.yamagata-u.ac.jp/~aito/w3m/
+
+;; If you would like to use this module in Gnus (not T-gnus), put this
+;; file into the lisp/ directory in the Gnus source tree and run
+;; `make install'. And then, copy the function definition of
+;; `gnus-group-make-shimbun-group' from the file gnus-group.el of
+;; T-gnus to somewhere else, for example .gnus file as follows:
+;;
+;;(eval-after-load "gnus-group"
+;; '(if (not (fboundp 'gnus-group-make-shimbun-group))
+;; (defun gnus-group-make-shimbun-group ()
+;; "Create a nnshimbun group."
+;; [...a function definition...])))
;;; Definitions:
(gnus-declare-backend "nnshimbun" 'address)
(eval-when-compile (require 'cl))
-(eval-when-compile (require 'gnus-clfns))
(require 'nnheader)
(require 'nnmail)
x))
(eval-and-compile
- (if (fboundp 'mime-entity-fetch-field)
- ;; For Semi-Gnus.
- (defun nnshimbun-make-shimbun-header (header)
- (shimbun-make-header
- (mail-header-number header)
- (mime-entity-fetch-field header 'Subject)
- (mime-entity-fetch-field header 'From)
- (mail-header-date header)
- (or (cdr (assq 'X-Nnshimbun-Id (mail-header-extra header)))
- (mail-header-id header))
- (mail-header-references header)
- (mail-header-chars header)
- (mail-header-lines header)
- (nnshimbun-header-xref header)))
- ;; For pure Gnus.
- (defun nnshimbun-make-shimbun-header (header)
- (shimbun-make-header
- (mail-header-number header)
- (mail-header-subject header)
- (mail-header-from header)
- (mail-header-date header)
- (or (cdr (assq 'X-Nnshimbun-Id (mail-header-extra header)))
- (mail-header-id header))
- (mail-header-references header)
- (mail-header-chars header)
- (mail-header-lines header)
- (nnshimbun-header-xref header)))))
+ (let ((Gnus-p
+ (eval-when-compile
+ (let ((gnus (locate-library "gnus"))
+ ;; Gnus has mailcap.el in the same directory of gnus.el.
+ (mailcap (locate-library "mailcap")))
+ (and gnus mailcap
+ (string-equal (file-name-directory gnus)
+ (file-name-directory mailcap)))))))
+ (if Gnus-p
+ (progn
+ (defmacro nnshimbun-mail-header-subject (header)
+ `(mail-header-subject ,header))
+ (defmacro nnshimbun-mail-header-from (header)
+ `(mail-header-from ,header)))
+ (defmacro nnshimbun-mail-header-subject (header)
+ `(mime-entity-fetch-field ,header 'Subject))
+ (defmacro nnshimbun-mail-header-from (header)
+ `(mime-entity-fetch-field ,header 'From)))))
+
+(defun nnshimbun-make-shimbun-header (header)
+ (shimbun-make-header
+ (mail-header-number header)
+ (nnshimbun-mail-header-subject header)
+ (nnshimbun-mail-header-from header)
+ (mail-header-date header)
+ (or (cdr (assq 'X-Nnshimbun-Id (mail-header-extra header)))
+ (mail-header-id header))
+ (mail-header-references header)
+ (mail-header-chars header)
+ (mail-header-lines header)
+ (nnshimbun-header-xref header)))
(defsubst nnshimbun-check-header (group header)
(let (flag)
(nnheader-nov-delete-outside-range
(if fetch-old (max 1 (- (car articles) fetch-old))
(car articles))
- (car (last articles)))
+ (and articles (nth (1- (length articles)) articles)))
t))))))
projects / elisp / gnus.git- / commitdiff