* lisp/initz-list.el (initz-list-previous-line): Add optional
[elisp/initz.git] / lisp / initz-list.el
index aa8a7da..93d6e3f 100644 (file)
 ;;; Code:
 
 (require 'emu)
+(require 'easymenu)
+(eval-when-compile (require 'cl))
 (require 'initz-globals)
 (require 'initz)
 
+(defvar initz-list-mode-menu
+  '("Initz"
+    ["View" initz-list-find-file t]
+    ["Byte-compile" initz-list-byte-compile-file t]
+    ["Delete" initz-list-delete-file t]
+    ["Load" initz-list-load-file t]
+    ["Make new file" initz-list-new-file t]
+    "----"
+    ["Startup" initz-startup t]
+    "----"
+    ["Quit" initz-list-quit t]))
+
 (defvar initz-list-mode-map nil
   "Local map for initz list buffers.")
 (unless initz-list-mode-map
@@ -51,6 +65,9 @@
       (define-key map "N" 'initz-list-new-file)
       (define-key map "S" 'initz-startup)
       (define-key map "q" 'initz-list-quit)
+      (easy-menu-define initz-list-mode-nemu map
+                       "Menu Used in 'initz-list-mode'."
+                       initz-list-mode-menu)
       (setq initz-list-mode-map map)))
 
 (defvar initz-list-node-map nil)
 (defconst initz-list-new-file-provided-message
   "Module is already provided.")
 
-(defconst initz-list-new-file-comment-message-format
+(defconst initz-list-new-file-header-message-format
   ";;; %s --- init file for %s.\n\n\n\n")
 
-(defconst initz-list-new-file-provide-message-format
-  "(provide '%s)\n")
+(defconst initz-list-new-file-footer-message-format
+  "(provide '%s)\n\n;;; %s ends here\n")
 
 (defconst initz-list-click-message-format
   "Click %s on the module name to select it.\n")
 (defconst initz-list-enter-message-format
   "In this buffer, type %s to select the module name under point.\n")
 
+(defconst initz-list-modeline-string
+  "Initz")
+
 ;; Initz list mode is suitable only for specially formatted data.
 (put 'initz-list-mode 'mode-class 'special)
 
   (when (or (eq major-mode 'initz-list-mode)
            (eq major-mode 'initz-error-mode))
     (setq ad-return-value
-         (mapcar
-          (function (lambda (list)
-                      (cons (cons (caar list) (1+ (cdar list)))
-                            (cons (cadr list) (1+ (cddr list))))))
-          ad-return-value))))
+         (mapcar #'(lambda (list)
+                     (cons (cons (caar list) (1+ (cdar list)))
+                           (cons (cadr list) (1+ (cddr list)))))
+                 ad-return-value))))
 
 (defun initz-list-delete-whole-line ()
   "Delete whole line at point."
 
 (defun initz-list-input-dir (&optional default)
   "Input the dir."
-  (let* ((completing-list (mapcar
-                          (function (lambda (list)
-                                      (symbol-name (car list))))
-                          initz-init-alist))
-        (default (if (stringp default) default "misc")))
+  (let ((completing-list (mapcar #'(lambda (list)
+                                    (symbol-name (car list)))
+                                initz-init-alist))
+       (default (if (stringp default) default "misc")))
     (completing-read
      (format initz-list-input-dir-message-format
             initz-directory default)
-     (mapcar
-      (function (lambda (name)
-                 (cons name name)))
-      completing-list)
+     (mapcar #'(lambda (name)
+                (cons name name))
+            completing-list)
      nil t nil nil default)))
 
 (defun initz-list-input-module (dir)
     (if initz-list-input-module-completing
        (completing-read
         (format initz-list-input-module-message-format dir)
-        (mapcar
-         (function (lambda (feature)
-                     (let ((name (symbol-name feature)))
-                       (cons name name))))
-         features)
+        (mapcar #'(lambda (feature)
+                    (let ((name (symbol-name feature)))
+                      (cons name name)))
+                features)
         nil nil init)
       (read-string
-        (format initz-list-input-module-message-format dir)
-        init))))
+       (format initz-list-input-module-message-format dir)
+       init))))
 
 (defun initz-list-insert-file (dir startup-file)
   "Insert the STARTUP-FILE at DIR section."
     (let ((sort-start (point))
          (initz-features (initz-features)))
       (mapc
-       (function (lambda (file)
-                  (let* ((module (initz-get-module-name file))
-                         (loaded (memq (intern module) initz-features))
-                         start)
-                    (insert-char ?\  4)
-                    (setq start (point))
-                    (insert module)
-                    (when loaded (insert initz-list-loaded-mark))
-                    (insert "\n")
-                    (add-text-properties
-                     start (1- (point))
-                     `(face ,(if loaded
-                                 'initz-list-module-face 
-                               'initz-list-unloaded-module-face)
-                       mouse-face highlight
-                       start-open t rear-nonsticky t
-                       help-echo ,file))
-                    (put-text-property start (point) :file file))))
-       (initz-get-files 'startup node))
+       #'(lambda (file)
+          (let* ((module (initz-get-module-name file))
+                 (loaded (memq (intern module) initz-features))
+                 start)
+            (insert-char ?\  4)
+            (setq start (point))
+            (insert module)
+            (when loaded (insert initz-list-loaded-mark))
+            (insert "\n")
+            (add-text-properties start (1- (point))
+                                 `(face ,(if loaded
+                                             'initz-list-module-face 
+                                           'initz-list-unloaded-module-face)
+                                   mouse-face highlight
+                                   start-open t rear-nonsticky t
+                                   help-echo ,file))
+            (put-text-property start (point) :file file)))
+       (initz-get-files 'startup node initz-list-all-modules))
       (sort-lines nil sort-start (point)))
     (set-buffer-modified-p nil)
     (setq buffer-read-only t)))
     (when (integer-or-marker-p start)
        (goto-char start))))
 
-(defun initz-list-previous-line ()
+(defun initz-list-previous-line (&optional arg)
   (interactive)
-  (initz-list-next-line -1))
+  (if (integerp arg)
+      (initz-list-next-line (- 0 arg))
+    (initz-list-next-line -1)))
 
 (defun initz-list-print-file ()
   "Print the file name under point."
   (interactive)
   (let ((file (get-text-property (point) :file)))
     (when file
-      (condition-case nil
-         (when (save-window-excursion
-                 (byte-compile-file file))
-           (let* ((compile-file (initz-get-correspondence-file file))
-                  (startup-directory (file-name-directory file))
-                  (flavor-directory (file-name-directory compile-file)))
-             (install-file (file-name-nondirectory compile-file)
-                           startup-directory flavor-directory t t))
-           (setq initz-compile-error-files
-                 (delete file initz-compile-error-files)))
-       (error)))))
+      (let ((compile-file (initz-get-correspondence-file file)))
+       (when (file-newer-than-file-p file compile-file)
+         (condition-case nil
+             (when (save-window-excursion
+                     (byte-compile-file file))
+               (let ((startup-directory (file-name-directory file))
+                     (flavor-directory (file-name-directory compile-file)))
+                 (install-file (file-name-nondirectory compile-file)
+                               startup-directory flavor-directory t t))
+               (setq initz-compile-error-files
+                     (delete file initz-compile-error-files)))
+           (error)))))))
 
 (defun initz-list-delete-file ()
   "Delete the file under point."
 (defun initz-list-load-file ()
   "Load the file under point."
   (interactive)
-  (let* ((file (get-text-property (point) :file)))
-    (initz-list-byte-compile-file)
-    (when (initz-load-file (initz-get-correspondence-file file))
+  (let ((file (get-text-property (point) :file)))
+    (when (and (initz-list-byte-compile-file)
+              (initz-load-file (initz-get-correspondence-file file)))
       (setq initz-load-error-files
            (delete file initz-load-error-files)))))
 
                 (string-match (concat "^" initz-module-regexp "$") module)))
        (message initz-list-new-file-illegal-message)
       (setq module (initz-trim-separator module))
-      (let* ((startup-file (expand-file-name
-                           (concat initz-prefix
-                                   (if (string= module initz-null-string)
-                                       initz-null-string
-                                     initz-separator-string)
-                                   module ".el")
-                           (initz-startup-directory (intern dir)))))
+      (let ((startup-file (expand-file-name
+                          (concat initz-prefix
+                                  (if (string= module initz-null-string)
+                                      initz-null-string
+                                    initz-separator-string)
+                                  module ".el")
+                          (initz-startup-directory (intern dir)))))
        (if (file-exists-p startup-file)
            (message initz-list-new-file-exists-message)
          (let ((base-name (initz-get-base-name startup-file)))
                (message initz-list-new-file-provided-message)
              (initz-list-insert-file dir startup-file)
              (find-file-other-window startup-file)
-             (insert (format initz-list-new-file-comment-message-format
-                             (file-name-nondirectory startup-file)
-                             (if (string= module initz-null-string)
-                                 initz-prefix
-                               module)))
-             (insert (format initz-list-new-file-provide-message-format
-                             base-name))
+             (let ((file-name (file-name-nondirectory startup-file)))
+               (insert (format initz-list-new-file-header-message-format
+                               file-name
+                               (if (string= module initz-null-string)
+                                   initz-prefix
+                                 module)))
+               (insert (format initz-list-new-file-footer-message-format
+                               base-name file-name)))
              (save-buffer)
              (goto-char (point-min))
              (search-forward "\n\n"))))))))
 \\[initz-list-load-file]       Load the file under point.
 \\[initz-list-new-file]        Make new init file.
 \\[initz-startup]      Initz startup.
+
 \\[initz-list-quit]    Quit the initz list mode."
   (interactive)
   (kill-all-local-variables)
   (use-local-map initz-list-mode-map)
   (setq mode-name initz-list-mode-name)
   (setq major-mode 'initz-list-mode)
+  (easy-menu-add initz-list-mode-menu)
   (when (or (featurep 'xemacs) (< emacs-major-version 21))
     (make-local-hook 'post-command-hook))
   (add-hook 'post-command-hook 'initz-list-print-file)
+  (setq mode-line-buffer-identification initz-list-modeline-string)
   (run-hooks 'initz-list-mode-hook))
 
 ;;;###autoload
    (format initz-list-enter-message-format
           (substitute-command-keys "\\[initz-list-find-file]")))
   (insert "\n")
-  (mapc
-   (function (lambda (alist)
-              (let ((sym (car alist)))
-                (funcall
-                 (intern (concat "initz-list-node-"
-                                 (symbol-name
-                                  initz-list-default-node-status)))
-                 sym))))
-   initz-init-alist)
+  (mapc #'(lambda (alist)
+           (let ((sym (car alist)))
+             (funcall (intern (concat "initz-list-node-"
+                                      (symbol-name
+                                       initz-list-default-node-status)))
+                      sym)))
+       initz-init-alist)
   (set-buffer-modified-p nil)
   (setq buffer-read-only t)
   (goto-char (point-min))