- (dolist (file files)
- (unless (file-exists-p file)
- (setq files (delete file files))))
- (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 giveup nil
- 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 nil)))
- (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))
- (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
- (setq buffer (get-buffer-create
- (concat "*CL run-time functions in: "
- file-or-directory "*"))))
+ (when files
+ (if (member arg '((4) (64) 1 3))
+ (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 nil))
+ (message "Searching for CL run-time functions in: %s..."
+ (file-name-nondirectory file))
+ (insert-file-contents file nil nil nil t)
+ ;; XEmacs moves point to the beginning of the buffer after
+ ;; inserting a file, FSFmacs doesn't so if the fifth argument
+ ;; of `insert-file-contents' is specified.
+ (goto-char (point-min))
+ ;;
+ (while (progn
+ (while (and (looking-at "[\t\v\f\r ]*\\(;.*\\)?$")
+ (zerop (forward-line 1))))
+ (not (eobp)))
+ (setcar lines (if (bolp)
+ (1+ (count-lines (point-min) (point)))
+ (count-lines (point-min) (point))))
+ (when (consp;; Ignore stand-alone symbols, strings, etc.
+ (setq form (condition-case nil
+ (read working)
+ (error nil))))
+ (setcdr lines (list (count-lines (point-min) (point))))
+ (setq forms (list form)
+ fns nil)
+ (while forms
+ (setq form (pop forms))
+ (when (consp form)
+ (setq fn (pop form))
+ (cond ((memq fn '(apply mapatoms mapcar mapconcat
+ mapextent symbol-function))
+ (if (consp (car form))
+ (when (memq (caar form) '(\` backquote quote))
+ (setcar form (cdar form)))
+ (setq form (cdr form))))
+ ((memq fn '(\` backquote quote))
+ (if report-symbols
+ (progn
+ (setq form (car form)
+ newform nil)
+ (while form
+ (push (list (or (car-safe form) form))
+ newform)
+ (setq form (cdr-safe form)))
+ (setq form (nreverse newform)))
+ (setq form nil)))
+ ((memq fn '(defadvice
+ defmacro defsubst defun
+ defmacro-maybe defmacro-maybe-cond
+ defsubst-maybe defun-maybe
+ defun-maybe-cond))
+ (setq form (cddr form)))
+ ((memq fn '(defalias lambda fset))
+ (setq form (cdr form)))
+ ((eq fn 'define-compiler-macro)
+ (setq form nil))
+ ((eq fn 'dolist)
+ (setcar form (cadar form)))
+ ((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))))
+ ((eq fn 'sort)
+ (when (and (consp (cadr form))
+ (memq (caadr form) '(\` backquote quote)))
+ (setcdr form (list (cdadr form)))))
+ ((and (memq fn clfns)
+ (listp form))
+ (push fn fns)))
+ (when (listp form)
+ (setq forms (append form forms)))))
+ (when fns
+ (if buffer