398 lines
17 KiB
EmacsLisp
398 lines
17 KiB
EmacsLisp
;;; dired-sort-menu+.el --- Extensions to `dired-sort-menu.el'
|
|
;;
|
|
;; Filename: dired-sort-menu+.el
|
|
;; Description: Extensions to `dired-sort-menu.el'
|
|
;; Author: Drew Adams
|
|
;; Maintainer: Drew Adams (concat "drew.adams" "@" "oracle" ".com")
|
|
;; Copyright (C) 2005-2018, Drew Adams, all rights reserved.
|
|
;; Created: Thu Jul 07 12:39:36 2005
|
|
;; Version: 0
|
|
;; Package-Requires: ((dired-sort-menu "0"))
|
|
;; Last-Updated: Fri Sep 21 13:38:59 2018 (-0700)
|
|
;; By: dradams
|
|
;; Update #: 140
|
|
;; URL: https://www.emacswiki.org/emacs/download/dired-sort-menu%2b.el
|
|
;; Doc URL: https://emacswiki.org/emacs/DiredSortMenu
|
|
;; Keywords: directories, diredp, dired
|
|
;; Compatibility: GNU Emacs: 20.x, 21.x, 22.x, 23.x, 24.x, 25.x, 26.x
|
|
;;
|
|
;; Features that might be required by this library:
|
|
;;
|
|
;; `dired', `dired-sort-menu', `easymenu', `wid-edit', `widget'.
|
|
;;
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;;
|
|
;;; Commentary:
|
|
;;
|
|
;; Extensions to `dired-sort-menu.el'
|
|
;;
|
|
;; Francis J. Wright <F.J.Wright@maths.qmw.ac.uk> wrote library
|
|
;; `dired-sort-menu.el'
|
|
;; (https://www.emacswiki.org/emacs/dired-sort-menu.el, originally
|
|
;; http://centaur.maths.qmw.ac.uk/Emacs/).
|
|
;;
|
|
;; Library `dired-sort-menu+.el' modifies `dired-sort-menu.el' to play
|
|
;; better with other libraries from Drew Adams.
|
|
;;
|
|
;; Changes:
|
|
;;
|
|
;; 1. The toggles for reverse sorting, `ls-lisp-ignore-case' and
|
|
;; `ls-lisp-dirs-first', are bound respectively to "a", "c", and
|
|
;; "W" in the dired map, instead of "r", "c" and "b".
|
|
;;
|
|
;; 2. We don't define `dired-sort-menu-toggle-ignore-case' and
|
|
;; `dired-sort-menu-toggle-dirs-first' unless they can be used.
|
|
;;
|
|
;; 3. `handle-delete-frame' is protected against nil `buffer-name'.
|
|
;;
|
|
;;
|
|
;; ***** NOTE: The following functions defined in `dired.el' have
|
|
;; been REDEFINED or ADVISED HERE:
|
|
;;
|
|
;; `dired-sort-dialogue' -
|
|
;; 1. Fit frame. 2. Do not add `dired-sort-dialogue-auto-kill-1'
|
|
;; to `kill-buffer-hook'.
|
|
;; `dired-sort-dialogue-close' - Just `kill-buffer'.
|
|
;; `handle-delete-frame' - Do nothing if `buffer-name' is nil.
|
|
;;
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;;
|
|
;;; Change Log:
|
|
;;
|
|
;; 2018/09/21 dadams
|
|
;; dired-sort-dialogue: Use pop-to-buffer-same-window, not switch-to-buffer.
|
|
;; 2011/06/18 dadams
|
|
;; Updated T prefix-key bindings, because added more in dired+.el.
|
|
;; 2011/04/19 dadams
|
|
;; Restore Dired+ bindings on prefix key T.
|
|
;; 2011/04/16 dadams
|
|
;; handle-delete-frame:
|
|
;; Fix for lexbind Emacs 24: replace named arg EVENT by (ad-get-arg 0).
|
|
;; 2005/11/05 dadams
|
|
;; Renamed dired+ stuff to have diredp- prefix.
|
|
;; 2005/11/02 dadams
|
|
;; Restore dired+ bindings messed up by dired-sort-menu.el.
|
|
;; Changed dired-sort-menu-toggle-reverse to "|" and
|
|
;; dired-sort-menu-toggle-dirs-first to "/".
|
|
;; 2005/07-26 dadams
|
|
;; Protected ls-lisp-var-p with fboundp.
|
|
;;
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;;
|
|
;; This program is free software; you can redistribute it and/or modify
|
|
;; it under the terms of the GNU General Public License as published by
|
|
;; the Free Software Foundation; either version 2, or (at your option)
|
|
;; any later version.
|
|
|
|
;; This program is distributed in the hope that it will be useful,
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;; GNU General Public License for more details.
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with this program; see the file COPYING. If not, write to
|
|
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
|
|
;; Floor, Boston, MA 02110-1301, USA.
|
|
;;
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;;
|
|
;;; Code:
|
|
|
|
(require 'dired-sort-menu) ; dired-sort-menu
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
|
|
;;; Keys ----------------------------------
|
|
|
|
;; Restore bindings set by `dired+.el'.
|
|
;; (They were changed by `dired-sort-menu.el'.)
|
|
;; There should be a better way to do this, but probably there isn't.
|
|
;;
|
|
;; Replaces `T' binding for `dired-sort-menu-swap-config' in `dired-sort-menu.el'.
|
|
;;
|
|
(when (fboundp 'diredp-rename-this-file)
|
|
(define-key dired-mode-map "b" 'diredp-byte-compile-this-file)
|
|
(define-key dired-mode-map "r" 'diredp-rename-this-file)
|
|
(define-key dired-mode-map "T" nil) ; For Emacs20
|
|
(define-key dired-mode-map "T+" 'diredp-tag-this-file) ; `T +'
|
|
(define-key dired-mode-map "T-" 'diredp-untag-this-file) ; `T -'
|
|
(define-key dired-mode-map "T0" 'diredp-remove-all-tags-this-file) ; `T 0'
|
|
(define-key dired-mode-map "Tc" 'diredp-copy-tags-this-file) ; `T c'
|
|
(define-key dired-mode-map "Tp" 'diredp-paste-add-tags-this-file) ; `T p'
|
|
(define-key dired-mode-map "Tq" 'diredp-paste-replace-tags-this-file) ; `T q'
|
|
(define-key dired-mode-map "Tv" 'diredp-set-tag-value-this-file) ; `T v'
|
|
(define-key dired-mode-map "T\M-w" 'diredp-copy-tags-this-file) ; `T M-w'
|
|
(define-key dired-mode-map "T\C-y" 'diredp-paste-add-tags-this-file) ; `T C-y'
|
|
(define-key dired-mode-map "T>+" 'diredp-do-tag) ; `T > +'
|
|
(define-key dired-mode-map "T>-" 'diredp-do-untag) ; `T > -'
|
|
(define-key dired-mode-map "T>0" 'diredp-do-remove-all-tags) ; `T > 0'
|
|
(define-key dired-mode-map "T>p" 'diredp-do-paste-add-tags) ; `T > p'
|
|
(define-key dired-mode-map "T>q" 'diredp-do-paste-replace-tags) ; `T > q'
|
|
(define-key dired-mode-map "T>v" 'diredp-do-set-tag-value) ; `T > v'
|
|
(define-key dired-mode-map "T>\C-y" 'diredp-do-paste-add-tags) ; `T > C-y'
|
|
(define-key dired-mode-map "Tm%" 'diredp-mark-files-tagged-regexp) ; `T m %'
|
|
(define-key dired-mode-map "Tm*" 'diredp-mark-files-tagged-all) ; `T m *'
|
|
(define-key dired-mode-map "Tm+" 'diredp-mark-files-tagged-some) ; `T m +'
|
|
(define-key dired-mode-map "Tm~*" 'diredp-mark-files-tagged-not-all) ; `T m ~ *'
|
|
(define-key dired-mode-map "Tm~+" 'diredp-mark-files-tagged-none) ; `T m ~ +'
|
|
(define-key dired-mode-map "Tu%" 'diredp-unmark-files-tagged-regexp) ; `T u %'
|
|
(define-key dired-mode-map "Tu*" 'diredp-unmark-files-tagged-all) ; `T u *'
|
|
(define-key dired-mode-map "Tu+" 'diredp-unmark-files-tagged-some) ; `T u +'
|
|
(define-key dired-mode-map "Tu~*" 'diredp-unmark-files-tagged-not-all) ; `T u ~ *'
|
|
(define-key dired-mode-map "Tu~+" 'diredp-unmark-files-tagged-none) ; `T u ~ +'
|
|
)
|
|
|
|
;; Use "|", not "r".
|
|
(define-key dired-mode-map "|" 'dired-sort-menu-toggle-reverse)
|
|
|
|
;; Don't define it unless you can use it.
|
|
(when (and (fboundp 'ls-lisp-var-p) (ls-lisp-var-p 'ls-lisp-ignore-case))
|
|
(define-key dired-mode-map "c" 'dired-sort-menu-toggle-ignore-case))
|
|
|
|
;; 1. Use "/", not "b". 2. Don't define it unless you can use it.
|
|
(when (and (fboundp 'ls-lisp-var-p) (ls-lisp-var-p 'ls-lisp-dirs-first))
|
|
(define-key dired-mode-map "/" 'dired-sort-menu-toggle-dirs-first))
|
|
|
|
|
|
;; Remove from menu-bar "Immediate" submenu, and add it to "Dir" submenu.
|
|
(easy-menu-remove-item dired-mode-map '("menu-bar" "immediate") "Sort By")
|
|
(easy-menu-add-item dired-mode-map '("menu-bar" "subdir") dired-sort-menu
|
|
'revert-buffer)
|
|
|
|
|
|
;;; Functions -----------------------------
|
|
|
|
|
|
;; REPLACE ORIGINAL in `dired-sort-menu.el'.
|
|
;;
|
|
;; 1. Fit frame.
|
|
;; 2. Removed `dired-sort-dialogue-auto-kill-1' from `kill-buffer-hook'.
|
|
;;
|
|
;;;###autoload
|
|
(defun dired-sort-dialogue ()
|
|
"A static dialogue version of the Dired sort menu.
|
|
This command *must* be run in the Dired buffer!"
|
|
(interactive)
|
|
(unless (eq major-mode 'dired-mode)
|
|
(error "This command may only be run in a Dired buffer"))
|
|
(let
|
|
;; Must set these variables while still in the dired buffer!
|
|
((radio (dired-sort-dialogue-choice))
|
|
(reverse (dired-sort-menu-switch-p "r"))
|
|
(recursive (dired-sort-menu-switch-p "R"))
|
|
(dired-buffer (current-buffer))
|
|
;; Suspend automatic mechanisms:
|
|
window-configuration-change-hook kill-buffer-hook)
|
|
|
|
;; Check whether a dialogue buffer for this dired buffer is
|
|
;; already visible, and if so re-use its window:
|
|
(let ((bufname (dired-sort-dialogue-buffer-name))
|
|
(bufs (buffer-list)) buf
|
|
(title (concat "<" (buffer-name dired-buffer) ">")))
|
|
(while (and bufs (not (string= bufname (buffer-name (setq buf (car bufs))))))
|
|
(setq bufs (cdr bufs)))
|
|
(if bufs
|
|
(progn
|
|
(if (dired-sort-dialogue-own-frame-really)
|
|
(progn
|
|
(select-frame (window-frame (get-buffer-window buf t)))
|
|
(raise-frame))
|
|
(select-window (get-buffer-window buf t)))
|
|
(set-window-dedicated-p (selected-window) nil)
|
|
(kill-buffer buf))
|
|
(if (dired-sort-dialogue-own-frame-really)
|
|
;; If room then put dialogue immediately to the right of
|
|
;; the dired frame, else at right edge of screen.
|
|
(let* ((alist (frame-parameters))
|
|
(top (cdr (assq 'top alist))) ; pixels
|
|
(left (cdr (assq 'left alist))) ; pixels
|
|
)
|
|
;; Allow form INTEGER or (+ INTEGER):
|
|
(or (atom left) (setq left (cadr left)))
|
|
;; Set left of dialogue frame to avoid falling off right
|
|
;; of display:
|
|
(setq left (+ left (frame-pixel-width))
|
|
left (if (> (+ left (* dired-sort-dialogue-width
|
|
(frame-char-width)))
|
|
(x-display-pixel-width))
|
|
-10
|
|
;; (+ left (* 2 (cdr (assq 'border-width alist))))))
|
|
(+ left 10)))
|
|
(select-frame (make-frame
|
|
`((title . ,title)
|
|
(top . ,top)
|
|
(left . ,left)
|
|
(width . ,dired-sort-dialogue-width)
|
|
(height . 22)
|
|
(minibuffer . nil)
|
|
(vertical-scroll-bars . nil)
|
|
(horizontal-scroll-bars . nil)
|
|
(unsplittable . nil)
|
|
(menu-bar-lines . 0)
|
|
))))
|
|
(split-window ; WINDOW SIZE HORIZONTAL
|
|
nil (- (window-width) dired-sort-dialogue-width) t)
|
|
(select-window (next-window))))
|
|
(if (fboundp 'pop-to-buffer-same-window)
|
|
(pop-to-buffer-same-window bufname)
|
|
(switch-to-buffer bufname))
|
|
(set-window-dedicated-p (selected-window) t) ; can crash Emacs!
|
|
(kill-all-local-variables)
|
|
;; (or buffer-display-table
|
|
;; (setq buffer-display-table
|
|
;; (or standard-display-table (make-display-table))))
|
|
;; (set-display-table-slot buffer-display-table 0 ?_)
|
|
(setq truncate-lines t
|
|
mode-line-format title))
|
|
|
|
(let ((inhibit-read-only t))
|
|
(erase-buffer))
|
|
;; Must set this only once in the dialogue buffer!
|
|
(setq dired-sort-dialogue-dired-buffer dired-buffer)
|
|
|
|
(let ((start (point)))
|
|
(widget-insert "Dired Sort Options")
|
|
(put-text-property start (point) 'face 'bold))
|
|
(widget-insert " for\n<"
|
|
(buffer-name dired-buffer)
|
|
">\n\n(Use any mouse button)\n\n ")
|
|
(setq dired-sort-dialogue-radio-widget
|
|
(eval `(widget-create
|
|
'radio-button-choice
|
|
:indent 1
|
|
:value radio
|
|
'(item :tag "Name" "")
|
|
'(item :tag "Time Modified" "t")
|
|
,@(if (dired-sort-menu-active-p "S")
|
|
'('(item :tag "Size" "S")))
|
|
,@(if (dired-sort-menu-active-p "X")
|
|
'('(item :tag "Extension" "X")))
|
|
,@(if (dired-sort-menu-active-p "U")
|
|
'('(item :tag "Unsorted" "U")))
|
|
,@(if (dired-sort-menu-active-p "c")
|
|
`('(item :tag
|
|
,(if (or (not (eq system-type 'windows-nt))
|
|
(dired-sort-menu-remote-p))
|
|
"Time Changed"
|
|
"Time Created") "c")))
|
|
,@(if (and (dired-sort-menu-active-p "u")
|
|
(or (not (eq system-type 'windows-nt))
|
|
(dired-sort-menu-remote-p)))
|
|
'('(item :tag "Time Accessed" "u")))
|
|
)))
|
|
(widget-insert " _____________________\n\n ")
|
|
(when (dired-sort-menu-active-p "r")
|
|
(setq dired-sort-dialogue-reverse-widget
|
|
(widget-create 'checkbox
|
|
:help-echo "Reverse the sort order"
|
|
reverse))
|
|
(widget-insert " Reverse\n "))
|
|
(when (dired-sort-menu-active-p "R")
|
|
(setq dired-sort-dialogue-recursive-widget
|
|
(widget-create 'checkbox
|
|
:help-echo "Recursively list all subdirectories"
|
|
recursive))
|
|
(widget-insert " Recursive\n "))
|
|
(when (ls-lisp-var-p 'ls-lisp-ignore-case)
|
|
(setq dired-sort-dialogue-ignore-case-widget
|
|
(widget-create 'checkbox
|
|
:help-echo "Ignore case when sorting"
|
|
ls-lisp-ignore-case))
|
|
(widget-insert " Ignore Case\n "))
|
|
(when (ls-lisp-var-p 'ls-lisp-dirs-first)
|
|
(setq dired-sort-dialogue-dirs-first-widget
|
|
(widget-create 'checkbox
|
|
:help-echo "Sort directories first"
|
|
ls-lisp-dirs-first))
|
|
(widget-insert " Dirs First\n "))
|
|
(widget-insert "_____________________\n\n ")
|
|
(widget-create 'push-button
|
|
:notify 'dired-sort-dialogue-OK
|
|
:help-echo "Apply the settings and close the window"
|
|
"OK")
|
|
(widget-insert " ")
|
|
(widget-create 'push-button
|
|
:notify 'dired-sort-dialogue-close
|
|
:help-echo "Close the window and ignore the settings"
|
|
"Cancel")
|
|
(widget-insert " ")
|
|
(widget-create 'push-button
|
|
:notify 'dired-sort-dialogue-apply
|
|
:help-echo "Apply the settings without closing the window"
|
|
"Apply")
|
|
(widget-setup)
|
|
(goto-char (point-min))
|
|
;; (use-local-map widget-keymap)
|
|
;; (let ((map (make-sparse-keymap)))
|
|
;; (suppress-keymap map)
|
|
;; (set-keymap-parent map widget-keymap)
|
|
;; (define-key map [down-mouse-1] 'widget-button-click)
|
|
;; (define-key map [down-mouse-3] 'widget-button-click)
|
|
;; (use-local-map map))
|
|
(let ((map widget-keymap))
|
|
;; (define-key map [t] 'undefined)
|
|
;; (define-key map [tab] 'widget-forward)
|
|
;; (define-key map [return] 'widget-button-press)
|
|
(define-key map [down-mouse-1] 'widget-button-click)
|
|
(define-key map [down-mouse-3] 'widget-button-click)
|
|
;; (define-key map [escape] (lambda () (interactive)
|
|
;; (dired-sort-dialogue-close)))
|
|
;; (define-key map "\C-h" 'describe-bindings)
|
|
(use-local-map map)))
|
|
;; D. Adams - added this line:
|
|
(when (fboundp 'fit-frame) (fit-frame))
|
|
|
|
;; Set up these hooks here to avoid any possibility of causing
|
|
;; trouble if the dialogue facility is not used:
|
|
|
|
;; D. Adams - REMOVED - not needed if use my stuff.
|
|
;; (add-hook 'kill-buffer-hook 'dired-sort-dialogue-auto-kill-1)
|
|
|
|
(add-hook 'window-configuration-change-hook
|
|
'dired-sort-dialogue-auto-kill-2))
|
|
|
|
|
|
;; REPLACE ORIGINAL in `dired-sort-menu.el'.
|
|
;;
|
|
;; Redefined to just `kill-buffer'. My other libraries take care of the rest.
|
|
;;
|
|
;;;###autoload
|
|
(defun dired-sort-dialogue-close (&rest ignore)
|
|
"Close the dired sort dialogue (ignoring the settings)."
|
|
(kill-buffer (current-buffer)))
|
|
;;; (defun dired-sort-dialogue-close (&rest ignore)
|
|
;;; "Close the dired sort dialogue (ignoring the settings)."
|
|
;;; (let ((dired-buffer dired-sort-dialogue-dired-buffer)
|
|
;;; window-configuration-change-hook
|
|
;;; kill-buffer-hook)
|
|
;;; (set-window-dedicated-p (selected-window) nil)
|
|
;;; (kill-buffer (current-buffer))
|
|
;;; (if (dired-sort-dialogue-own-frame-really)
|
|
;;; (delete-frame)
|
|
;;; (or (one-window-p t) (delete-window)))
|
|
;;; (select-window (get-buffer-window dired-buffer))))
|
|
|
|
|
|
;; REPLACE ORIGINAL in `dired-sort-menu.el'.
|
|
;;
|
|
;; Protect in case `buffer-name' is nil.
|
|
;;
|
|
(defadvice handle-delete-frame
|
|
(before handle-delete-frame-advice activate)
|
|
"Kill dialogue buffer before killing its frame."
|
|
(let* ((frame (posn-window (event-start (ad-get-arg 0))))
|
|
(buf (car (buffer-list frame))))
|
|
(when (and (buffer-name buf)
|
|
(dired-sort-dialogue-buffer-p (buffer-name buf)))
|
|
(set-window-dedicated-p (selected-window) nil)
|
|
(kill-buffer buf))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(provide 'dired-sort-menu+)
|
|
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;;; dired-sort-menu+.el ends here
|