From 1456ef4e518b2e30ae51bf23255c5ab16ef1fae5 Mon Sep 17 00:00:00 2001 From: yamaoka Date: Tue, 29 May 2001 23:43:42 +0000 Subject: [PATCH] * gnus-clfns.el (find-cl-run-time-functions): Add a parser for `dolist'; protect against errors. --- ChangeLog | 5 +++ lisp/gnus-clfns.el | 115 +++++++++++++++++++++++++++++----------------------- 2 files changed, 70 insertions(+), 50 deletions(-) diff --git a/ChangeLog b/ChangeLog index 25534bc..ef0bf25 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,10 @@ 2001-05-29 Katsumi Yamaoka + * lisp/gnus-clfns.el (find-cl-run-time-functions): Add a parser for + `dolist'; protect against errors. + +2001-05-29 Katsumi Yamaoka + * lisp/nnshimbun.el (nnshimbun-retrieve-headers-with-nov): Don't use `last'. (nnshimbun-make-shimbun-header): Use the following macros. diff --git a/lisp/gnus-clfns.el b/lisp/gnus-clfns.el index e072b30..f3ee463 100644 --- a/lisp/gnus-clfns.el +++ b/lisp/gnus-clfns.el @@ -205,18 +205,17 @@ ;;;###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." + "Find CL run-time functions in the FILE-OR-DIRECTORY. If the prefix +argument 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 + (let (files clfns working giveup file lines forms fns pt 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) + insert-file-contents-post-hook insert-file-contents-pre-hook) (cond ((file-directory-p file-or-directory) (prog1 (setq files (directory-files file-or-directory t "\\.el$")) @@ -226,6 +225,9 @@ not be reported." (setq files (list file-or-directory))) (t (message "No such file or directory: %s" file-or-directory))) + (dolist (file files) + (unless (file-exists-p file) + (setq files (delete file files)))) (if files (progn (if in-this-emacs @@ -240,7 +242,8 @@ not be reported." (let (emacs-lisp-mode-hook) (emacs-lisp-mode)) (while files - (setq file (pop files) + (setq giveup nil + file (pop files) lines (list nil 1)) (message "Searching for CL run-time functions in: %s..." (file-name-nondirectory file)) @@ -250,10 +253,11 @@ not be reported." ;; (while (setq forms (condition-case nil (list (read working)) - (error))) + (error nil))) (setq fns nil pt (point) - lines (list (cadr lines) (count-lines (point-min) pt))) + lines (list (cadr lines) + (count-lines (point-min) pt))) (condition-case nil (progn (forward-list -1) @@ -262,46 +266,57 @@ not be reported." (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 + (setq form (pop forms)) + (if (consp form) + (progn + (setq 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)))) + ((eq fn 'dolist) + (setcar form (cadar 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)))) + (goto-char (point-max)) + (setq giveup t + lines (list (cadr lines) + (count-lines (point-min) (point))) + fns '("Couldn't parse, check this file manually.")))) + (when (or fns giveup) (if buffer (set-buffer buffer) (display-buffer @@ -315,7 +330,7 @@ not be reported." (setq file nil)) (insert (format "%5d - %5d: %s" (car lines) (cadr lines) - (mapconcat 'symbol-name + (mapconcat (lambda (fn) (format "%s" fn)) (nreverse fns) " "))) (while (> (current-column) 78) (skip-chars-backward "^ ") -- 1.7.10.4