Commits

Fuco  committed 0679b86

Update dired crap

  • Participants
  • Parent commits de8ed11

Comments (0)

Files changed (6)

File files/dired-defs.el

   (visual-line-mode -1)
   (toggle-truncate-lines 1))
 (add-hook 'dired-mode-hook 'my-dired-init)
+(add-hook 'dired-after-readin-hook 'my-format-available-space)
+
+(defun my-format-available-space ()
+  (save-excursion
+    (goto-char (point-min))
+    (forward-line)
+    (when (search-forward "directory" (line-end-position) t)
+      (forward-char)
+      (let* ((avail (word-at-point))
+             (avail-hr (s-trim (ls-lisp-format-file-size (* 1024 (string-to-int avail)) t 1)))
+             (inhibit-read-only t)
+             (kill-ring kill-ring))
+        (kill-word 1)
+        (insert avail-hr)))
+    (when (search-forward "available" (line-end-position) t)
+      (forward-char)
+      (let* ((avail (word-at-point))
+             (avail-hr (s-trim (ls-lisp-format-file-size (* 1024 (string-to-int avail)) t 1)))
+             (inhibit-read-only t)
+             (kill-ring kill-ring))
+        (kill-word 1)
+        (insert avail-hr)))))
 
 (defun my-dired-filter-by-regexp (regexp)
   (interactive "sRegexp: ")
 ;; these functions depend on the dired plus package
 (defun dired-virtual-revert (&optional _arg _noconfirm)
   "Enable revert for virtual direds."
-  (let ((m (dired-file-name-at-point)))
+  (let ((m (dired-file-name-at-point))
+        (buffer-modified (buffer-modified-p)))
     (goto-char 1)
     (dired-next-subdir 1)
     (dired-do-redisplay nil t)
     (while (dired-next-subdir 1 t)
       (dired-do-redisplay nil t))
     (when m (dired-goto-file m))
+    (set-buffer-modified-p buffer-modified)))
+
+(defun dired-virtual-save-buffer ()
+  (let ((subdirs (nreverse (mapcar 'car dired-subdir-alist)))
+        (title (buffer-name))
+        (file (buffer-file-name)))
+    (with-temp-buffer
+      (--map (insert "  " it ":\n\n") subdirs)
+      (goto-char (point-min))
+      (forward-line)
+      (insert "  " title "\n")
+      (write-region (point-min) (point-max) (file-truename file)))
+    (set-buffer-modified-p nil)
+    t))
+
+(defadvice dired-maybe-insert-subdir (around fix-virtual-dired activate)
+  ad-do-it
+  (when (bound-and-true-p my-virtual-dired-p)
     (set-buffer-modified-p t)))
 
 (defun my-dired-ido-find-file ()
 (require 'ls-lisp)
 
 ;; redefine this function, to fix the formatting of file sizes in dired mode
-(defun ls-lisp-format-file-size (file-size human-readable)
+(defun ls-lisp-format-file-size (file-size &optional human-readable level)
+  (setq level (or level 1000))
   (if (or (not human-readable)
           (< file-size 1024))
       (format (if (floatp file-size) " %11.0f" " %11d") file-size)
     (do ((file-size (/ file-size 1024.0) (/ file-size 1024.0))
          ;; kilo, mega, giga, tera, peta, exa
-         (post-fixes (list "k" "M" "G" "T" "P" "E") (cdr post-fixes)))
-        ((< file-size 1024) (format " %10.0f%s"  file-size (car post-fixes))))))
+         (post-fixes (list "k" "M" "G" "T" "P" "E") (cdr post-fixes))
+         (l level (1- l)))
+        ((or (= 0 l)
+             (< file-size 1024)) (format " %10.0f%s"  file-size (car post-fixes))))))
 
 (defvar dired-sort-modes-list
   '(("size" "S" "")
 (defun my-dired-find-file ()
   "In Dired, visit the file or directory named on this line.
 
-Like `dired-file-file' but handles archives via avfs."
+If point is on a file, behaves like `dired-file-file' but handles
+archives via avfs.
+
+If point is on a directory header, open a new dired for the
+directory under point."
   (interactive)
-  (let ((file (dired-get-file-for-visit))
+  (let ((file (condition-case nil
+                  (dired-get-file-for-visit)
+                (error "")))
         (find-file-run-dired t))
-    (if (my-avfs-archive-p file)
-        (my-open-avfs file)
-      (find-file file))))
+    (cond
+     ((my-avfs-archive-p file)
+      (my-open-avfs file))
+     ((dired-get-subdir)
+      (-when-let (end (save-excursion (re-search-forward "[/:]" (line-end-position) t)))
+        (let ((path (buffer-substring-no-properties
+                     (+ 2 (line-beginning-position))
+                     (1- end))))
+          (find-file path))))
+     (t
+      (find-file file)))))
 (define-key dired-mode-map [remap dired-find-file] 'my-dired-find-file)
 
 (defadvice find-file-noselect (before fix-avfs-arguments activate)

File files/emacs-custom.el

  '(diredp-read-priv ((t nil)))
  '(diredp-write-priv ((t nil)))
  '(eldoc-highlight-function-argument ((t (:inherit bold :foreground "#4e9a06"))))
- '(erc-nick-default-face ((t (:inherit erc-default))))
+ '(erc-nick-default-face ((t (:inherit erc-default))) t)
  '(eshell-prompt ((t (:foreground "#73d216" :weight normal))) t)
  '(font-latex-sedate-face ((t (:inherit font-lock-keyword-face))))
  '(guide-key/key-face ((t (:inherit font-lock-keyword-face))))
  '(org-block-background ((t (:background "#232a2b" :height 98 :family "Consolas"))))
  '(org-formula ((t (:inherit fixed-pitch :foreground "chocolate1"))))
  '(org-mode-line-clock ((t nil)) t)
- '(org-table ((t (:inherit fixed-pitch :foreground "#8cc4ff" :height 98))) t)
+ '(org-table ((t (:inherit fixed-pitch :foreground "#8cc4ff" :height 98))))
  '(org-verbatim ((t (:inherit org-code))))
  '(sp-pair-overlay-face ((t (:background "#004a5d"))))
  '(sp-show-pair-enclosing ((t (:background "#004a5d"))))

File files/keys.el

     `(progn
        (defun ,fname ()
          (interactive)
-         (goto-char (point-min))
-         ,@forms)
+         (let ((p (point)))
+           (goto-char (point-min))
+           ,@forms
+           (when (= p (point))
+             (goto-char (point-min)))))
        (add-hook ',mode-hook (lambda () (define-key ,mode-map [remap beginning-of-buffer] ',fname))))))
 
 (defmacro my-special-buffer-jump-to-bottom (mode &rest forms)
     `(progn
        (defun ,fname ()
          (interactive)
-         (goto-char (point-max))
-         ,@forms)
+         (let ((p (point)))
+           (goto-char (point-max))
+           ,@forms
+           (when (= p (point))
+             (goto-char (point-max)))))
        (add-hook ',mode-hook (lambda () (define-key ,mode-map [remap end-of-buffer] ',fname))))))
 
 (my-special-buffer-back-to-top dired

File files/vendor.el

          ("C-x C-j" . dired-jump))
   :init
   (progn
+    (defvar my-virtual-dired-p nil
+      "Non-nil if the buffer is virtual dired.")
+
     (defun my-virtual-dired-mode ()
       (save-excursion
         (goto-char (point-min))
         (back-to-indentation)
-        (let ((ddir (thing-at-point 'filename)))
-          (virtual-dired (substring ddir 0 (1- (length ddir)))))
-        (dired-virtual-revert)))
+        (let* ((ddir (thing-at-point 'filename))
+               (dired-buffers dired-buffers))
+          (virtual-dired (substring ddir 0 (1- (length ddir))))
+          (set-buffer-modified-p nil)
+          (setq write-contents-functions 'dired-virtual-save-buffer)
+          (set (make-local-variable 'my-virtual-dired-p) t))
+        (goto-line 2)
+        (let ((buffer-name (s-trim (thing-at-point 'line))))
+          (dired-virtual-revert)
+          (rename-buffer buffer-name))))
 
     (defun my-dired-files (&optional arg)
       "Like `ido-dired'.  With prefix argument call
                          ("melpa" . "http://melpa.milkbox.net/packages/")
                          ("org" . "http://orgmode.org/elpa/")))
 
-(with-elapsed-timer "Initializing packages"
+(use-package-with-elapsed-timer "Initializing packages"
   (package-initialize)
   (load "~/.emacs.d/autoinstall")
 
 (autoload 'zap-up-to-char "misc"
   "Kill up to, but not including ARGth occurrence of CHAR." t)
 
-(with-elapsed-timer "Loading site lisp"
+(use-package-with-elapsed-timer "Loading site lisp"
   ;; load site lisp
   (load "site-lisp/advices")
   (load "site-lisp/defuns-buffer")
   (load "files/keys"))
 
 ;; load settings
-(with-elapsed-timer "Loading settings"
+(use-package-with-elapsed-timer "Loading settings"
   (load "files/global")
   (load "files/layouts")
   (load "files/mode-line")
   (load "files/windows"))
 
 ;; load config files
-(with-elapsed-timer "Loading vendor"
+(use-package-with-elapsed-timer "Loading vendor"
   (load "files/vendor"))
 
 ;; diminish useless modeline clutter

File site-lisp/emacs-lisp-mode.el

         ("C-M-;" 'clippy-describe-function)
         ("C-. ." 'my-describe-thing-in-buffer)
         ("C-x C-d l" 'my-extract-to-let)
-        ("C-x C-d m" 'my-merge-let-forms))
+        ("C-x C-d m" 'my-merge-let-forms)
+        ("C-x C-d c" 'my-lisp-condify-if))
 
       (set-input-method "english-prog")
       (eldoc-mode 1)
       (goto-char beg)
       (insert "("))
 
-    (defun my-goto-dominating-let ()
-      "Find dominating let form"
+    (defun my-goto-dominating-form (what)
+      "Find dominating form starting with WHAT."
+      (unless (listp what) (setq what (list what)))
       (while (and (> (car (syntax-ppss)) 0)
                   (not (ignore-errors
                          (backward-up-list)
                          (save-excursion
                            (down-list)
-                           (memq (symbol-at-point) '(let let*))))))))
+                           (memq (symbol-at-point) what)))))))
 
     (defun my-extract-to-let (name &optional arg)
       "Extract the form at point into a variable called NAME placed
         (save-excursion
           (cond
            (raw
-            (my-goto-dominating-let)
+            (my-goto-dominating-form '(let let*))
             (progn
               (down-list)
               (forward-sexp 2)
       "Merge the most inner let form into the next outer one."
       (interactive)
       (save-excursion
-        (my-goto-dominating-let)
+        (my-goto-dominating-form '(let let*))
         (down-list)
         (forward-sexp 2)
         (backward-sexp)
         (let ((var-list (sp-get (sp--next-thing-selection) (delete-and-extract-region :beg-prf :end))))
           (sp-splice-sexp-killing-backward 1)
-          (my-goto-dominating-let)
+          (my-goto-dominating-form '(let let*))
           (down-list)
           (forward-sexp 2)
           (backward-down-list)
           (backward-down-list)
           (sp-unwrap-sexp)
           (backward-up-list 2)
-          (indent-sexp))))))
+          (indent-sexp))))
+
+    (defun my-next-sexp ()
+      (ignore-errors
+        (forward-sexp 2)
+        (backward-sexp)))
+
+    (defun my-lisp-condify-if ()
+      (interactive)
+      (save-excursion
+        (my-goto-dominating-form 'if)
+        (let ((p (point)))
+          (down-list)
+          (my-next-sexp)
+          (let ((condition (sexp-at-point))
+                (body1 (progn
+                         (my-next-sexp)
+                         (sexp-at-point)))
+                (body2 (progn
+                         (my-next-sexp)
+                         (sexp-at-point))))
+            (goto-char p)
+            (cl-destructuring-bind (beg . end) (bounds-of-thing-at-point 'sexp)
+              (delete-region beg end))
+            (insert
+             (format "(cond
+                   (%s
+                     %s)
+                   (t
+                     %s))" condition body1 body2))
+            (goto-char p)
+            (indent-sexp)))))))