/[emacs]/emacs/lisp/startup.el
ViewVC logotype

Diff of /emacs/lisp/startup.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.273 by pj, Fri Nov 16 18:33:46 2001 UTC revision 1.274 by monnier, Sat Nov 17 00:08:20 2001 UTC
# Line 355  or `CVS', and any subdirectory that cont Line 355  or `CVS', and any subdirectory that cont
355      ;; This loop does a breadth-first tree walk on DIR's subtree,      ;; This loop does a breadth-first tree walk on DIR's subtree,
356      ;; putting each subdir into DIRS as its contents are examined.      ;; putting each subdir into DIRS as its contents are examined.
357      (while pending      (while pending
358        (setq dirs (cons (car pending) dirs))        (push (pop pending) dirs)
       (setq pending (cdr pending))  
359        (let* ((this-dir (car dirs))        (let* ((this-dir (car dirs))
360               (contents (directory-files this-dir))               (contents (directory-files this-dir))
361               (default-directory this-dir)               (default-directory this-dir)
# Line 368  or `CVS', and any subdirectory that cont Line 367  or `CVS', and any subdirectory that cont
367          (setq attrs (or canonicalized          (setq attrs (or canonicalized
368                          (nthcdr 10 (file-attributes this-dir))))                          (nthcdr 10 (file-attributes this-dir))))
369          (unless (member attrs normal-top-level-add-subdirs-inode-list)          (unless (member attrs normal-top-level-add-subdirs-inode-list)
370            (setq normal-top-level-add-subdirs-inode-list            (push attrs normal-top-level-add-subdirs-inode-list)
371                  (cons attrs normal-top-level-add-subdirs-inode-list))            (dolist (file contents)
           (while contents  
372              ;; The lower-case variants of RCS and CVS are for DOS/Windows.              ;; The lower-case variants of RCS and CVS are for DOS/Windows.
373              (unless (member (car contents) '("." ".." "RCS" "CVS" "rcs" "cvs"))              (unless (member file '("." ".." "RCS" "CVS" "rcs" "cvs"))
374                (when (and (string-match "\\`[[:alnum:]]" (car contents))                (when (and (string-match "\\`[[:alnum:]]" file)
375                           ;; Avoid doing a `stat' when it isn't necessary                           ;; Avoid doing a `stat' when it isn't necessary
376                           ;; because that can cause trouble when an NFS server                           ;; because that can cause trouble when an NFS server
377                           ;; is down.                           ;; is down.
378                           (not (string-match "\\.elc?\\'" (car contents)))                           (not (string-match "\\.elc?\\'" file))
379                           (file-directory-p (car contents)))                           (file-directory-p file))
380                  (let ((expanded (expand-file-name (car contents))))                  (let ((expanded (expand-file-name file)))
381                    (unless (file-exists-p (expand-file-name ".nosearch"                    (unless (file-exists-p (expand-file-name ".nosearch"
382                                                             expanded))                                                             expanded))
383                      (setq pending (nconc pending (list expanded)))))))                      (setq pending (nconc pending (list expanded)))))))))))
             (setq contents (cdr contents))))))  
384      (normal-top-level-add-to-load-path (cdr (nreverse dirs)))))      (normal-top-level-add-to-load-path (cdr (nreverse dirs)))))
385    
386  ;; This function is called from a subdirs.el file.  ;; This function is called from a subdirs.el file.
# Line 426  or `CVS', and any subdirectory that cont Line 423  or `CVS', and any subdirectory that cont
423      (let ((tail load-path)      (let ((tail load-path)
424            new)            new)
425        (while tail        (while tail
426          (setq new (cons (car tail) new))          (push (car tail) new)
427          (condition-case nil          (condition-case nil
428              (let ((default-directory (car tail)))              (let ((default-directory (car tail)))
429                (load (expand-file-name "subdirs.el" (car tail)) t t t)))                (load (expand-file-name "subdirs.el" (car tail)) t t t)))
# Line 717  or `CVS', and any subdirectory that cont Line 714  or `CVS', and any subdirectory that cont
714      (while (and (not done) args)      (while (and (not done) args)
715        (let ((longopts '(("--no-init-file") ("--no-site-file") ("--user")        (let ((longopts '(("--no-init-file") ("--no-site-file") ("--user")
716                          ("--debug-init") ("--iconic") ("--icon-type")))                          ("--debug-init") ("--iconic") ("--icon-type")))
717              (argi (car args))              (argi (pop args))
718              (argval nil))              (argval nil))
719          ;; Handle --OPTION=VALUE format.          ;; Handle --OPTION=VALUE format.
720          (if (and (string-match "\\`--" argi)          (if (and (string-match "\\`--" argi)
# Line 735  or `CVS', and any subdirectory that cont Line 732  or `CVS', and any subdirectory that cont
732                        (setq argi (substring (car elt) 1)))                        (setq argi (substring (car elt) 1)))
733                    (setq argval nil)))))                    (setq argval nil)))))
734          (cond          (cond
735           ((or (string-equal argi "-q")           ((member argi '("-q" "-no-init-file"))
736                (string-equal argi "-no-init-file"))            (setq init-file-user nil))
737            (setq init-file-user nil           ((member argi '("-u" "-user"))
                 args (cdr args)))  
          ((or (string-equal argi "-u")  
               (string-equal argi "-user"))  
738            (or argval            (or argval
739                (setq args (cdr args)                (setq argval (pop args)))
                     argval (car args)))  
740            (setq init-file-user argval            (setq init-file-user argval
741                  argval nil                  argval nil))
                 args (cdr args)))  
742           ((string-equal argi "-no-site-file")           ((string-equal argi "-no-site-file")
743            (setq site-run-file nil            (setq site-run-file nil))
                 args (cdr args)))  
744           ((string-equal argi "-debug-init")           ((string-equal argi "-debug-init")
745            (setq init-file-debug t            (setq init-file-debug t))
                 args (cdr args)))  
746           ((string-equal argi "-iconic")           ((string-equal argi "-iconic")
747            (setq initial-frame-alist            (push '(visibility . icon) initial-frame-alist))
                 (cons '(visibility . icon) initial-frame-alist))  
           (setq args (cdr args)))  
748           ((or (string-equal argi "-icon-type")           ((or (string-equal argi "-icon-type")
749                (string-equal argi "-i")                (string-equal argi "-i")
750                (string-equal argi "-itype"))                (string-equal argi "-itype"))
751            (setq default-frame-alist            (push '(icon-type . t) default-frame-alist))
752                  (cons '(icon-type . t) default-frame-alist))           ;; Push the popped arg back on the list of arguments.
753            (setq args (cdr args)))           (t (push argi args) (setq done t)))
          (t (setq done t)))  
754          ;; Was argval set but not used?          ;; Was argval set but not used?
755          (and argval          (and argval
756               (error "Option `%s' doesn't allow an argument" argi))))               (error "Option `%s' doesn't allow an argument" argi))))
# Line 778  or `CVS', and any subdirectory that cont Line 765  or `CVS', and any subdirectory that cont
765    ;; If frame was created with a menu bar, set menu-bar-mode on.    ;; If frame was created with a menu bar, set menu-bar-mode on.
766    (if (and (not noninteractive)    (if (and (not noninteractive)
767             (or (not (memq window-system '(x w32)))             (or (not (memq window-system '(x w32)))
768                 (> (cdr (assq 'menu-bar-lines (frame-parameters))) 0)))                 (> (frame-parameter nil 'menu-bar-lines) 0)))
769        (menu-bar-mode t))        (menu-bar-mode t))
770    
771    ;; If frame was created with a tool bar, switch tool-bar-mode on.    ;; If frame was created with a tool bar, switch tool-bar-mode on.
# Line 873  or `CVS', and any subdirectory that cont Line 860  or `CVS', and any subdirectory that cont
860                (lambda ()                (lambda ()
861                  (if init-file-user                  (if init-file-user
862                      (let ((user-init-file-1                      (let ((user-init-file-1
863                             (cond                             (cond
864                              ((eq system-type 'ms-dos)                              ((eq system-type 'ms-dos)
865                               (concat "~" init-file-user "/_emacs"))                               (concat "~" init-file-user "/_emacs"))
866                              ((eq system-type 'windows-nt)                              ((eq system-type 'windows-nt)
# Line 882  or `CVS', and any subdirectory that cont Line 869  or `CVS', and any subdirectory that cont
869                                 "~/_emacs"))                                 "~/_emacs"))
870                              ((eq system-type 'vax-vms)                              ((eq system-type 'vax-vms)
871                               "sys$login:.emacs")                               "sys$login:.emacs")
872                              (t                              (t
873                               (concat "~" init-file-user "/.emacs")))))                               (concat "~" init-file-user "/.emacs")))))
874                        ;; This tells `load' to store the file name found                        ;; This tells `load' to store the file name found
875                        ;; into user-init-file.                        ;; into user-init-file.
# Line 893  or `CVS', and any subdirectory that cont Line 880  or `CVS', and any subdirectory that cont
880                        ;; set user-init-file conclusively to nil;                        ;; set user-init-file conclusively to nil;
881                        ;; don't let it be set from default.el.                        ;; don't let it be set from default.el.
882                        (if (eq user-init-file t)                        (if (eq user-init-file t)
883                            (setq user-init-file nil))                            (setq user-init-file user-init-file-1))
884                                                
885                        ;; If we loaded a compiled file, set                        ;; If we loaded a compiled file, set
886                        ;; `user-init-file' to the source version if that                        ;; `user-init-file' to the source version if that
# Line 1337  where FACE is a valid face specification Line 1324  where FACE is a valid face specification
1324              (column 0))              (column 0))
1325    
1326          ;; Add the long X options to longopts.          ;; Add the long X options to longopts.
1327          (setq tem command-line-x-option-alist)          (dolist (tem command-line-x-option-alist)
1328          (while tem            (if (string-match "^--" (car tem))
1329            (if (string-match "^--" (car (car tem)))                (push (list (car tem)) longopts)))
               (setq longopts (cons (list (car (car tem))) longopts)))  
           (setq tem (cdr tem)))  
1330    
1331          ;; Loop, processing options.          ;; Loop, processing options.
1332          (while (and command-line-args-left)          (while (and command-line-args-left)
# Line 1383  where FACE is a valid face specification Line 1368  where FACE is a valid face specification
1368                           (funcall (cdr tem) argi))                           (funcall (cdr tem) argi))
1369                       (funcall (cdr tem) argi)))                       (funcall (cdr tem) argi)))
1370    
1371                    ((or (string-equal argi "-f") ;what the manual claims                    ((member argi '("-f"  ;what the manual claims
1372                         (string-equal argi "-funcall")                                    "-funcall"
1373                         (string-equal argi "-e")) ; what the source used to say                                    "-e")) ; what the source used to say
1374                     (if argval                     (if argval
1375                         (setq tem (intern argval))                         (setq tem (intern argval))
1376                       (setq tem (intern (car command-line-args-left)))                       (setq tem (intern (car command-line-args-left)))
# Line 1394  where FACE is a valid face specification Line 1379  where FACE is a valid face specification
1379                         (command-execute tem)                         (command-execute tem)
1380                       (funcall tem)))                       (funcall tem)))
1381    
1382                    ((or (string-equal argi "-eval")                    ((member argi '("-eval" "-execute"))
                        (string-equal argi "-execute"))  
1383                     (if argval                     (if argval
1384                         (setq tem argval)                         (setq tem argval)
1385                       (setq tem (car command-line-args-left))                       (setq tem (car command-line-args-left))
# Line 1403  where FACE is a valid face specification Line 1387  where FACE is a valid face specification
1387                     (eval (read tem)))                     (eval (read tem)))
1388                    ;; Set the default directory as specified in -L.                    ;; Set the default directory as specified in -L.
1389    
1390                    ((or (string-equal argi "-L")                    ((member argi '("-L" "-directory"))
                        (string-equal argi "-directory"))  
1391                     (if argval                     (if argval
1392                         (setq tem argval)                         (setq tem argval)
1393                       (setq tem (car command-line-args-left)                       (setq tem (car command-line-args-left)
# Line 1415  where FACE is a valid face specification Line 1398  where FACE is a valid face specification
1398                     (setq load-path (append (nreverse extra-load-path)                     (setq load-path (append (nreverse extra-load-path)
1399                                             initial-load-path)))                                             initial-load-path)))
1400    
1401                    ((or (string-equal argi "-l")                    ((member argi '("-l" "-load"))
                        (string-equal argi "-load"))  
1402                     (if argval                     (if argval
1403                         (setq tem argval)                         (setq tem argval)
1404                       (setq tem (car command-line-args-left)                       (setq tem (car command-line-args-left)
# Line 1452  where FACE is a valid face specification Line 1434  where FACE is a valid face specification
1434                     (setq command-line-args-left                     (setq command-line-args-left
1435                           (nthcdr (nth 1 tem) command-line-args-left)))                           (nthcdr (nth 1 tem) command-line-args-left)))
1436    
1437                    ((or (string-equal argi "-find-file")                    ((member argi '("-find-file" "-file" "-visit"))
                        (string-equal argi "-file")  
                        (string-equal argi "-visit"))  
1438                     ;; An explicit option to specify visiting a file.                     ;; An explicit option to specify visiting a file.
1439                     (if argval                     (if argval
1440                         (setq tem argval)                         (setq tem argval)

Legend:
Removed from v.1.273  
changed lines
  Added in v.1.274

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26