;; -*- mode: emacs-lisp; coding: hebrew-iso-8bit-unix; -*-
;; ekdired.el --- Simon & Wiesel DIRED added command for GNU emacs (19+)
;; Copyright (C) 1992-2000  Ehud karni <ehud@unix.simonwiesel.co.il>

;; This file is NOT part of GNU Emacs, distribution conditions below.
;;
;;              EHUD   KARNI            éðø÷   ãåäà
;;              Ben Gurion st'   14   ïåéøåâ ïá 'çø
;;              Kfar - Sava    44 257     àáñ - øôë
;;              ===================================
;;              <kehud@iname.com>  972-(0)9-7659599
;;              ===================================

;;     LOG: $Log: ekdired.el,v $
;;  Revision 1.106  2000/03/05  11:41:13  ehud
;;  Hack dired-find-file-* for better visiting symbolics (ftp/dired).
;;  Add dired-restore-8bit-chars for W9x/DOS names, Change touch to touch-t
;;  script, fix dired-get-file-time, Improve dired-sort-after-revert,
;;  Add dired-w32-open, dired-w32-print for W9x handling.
;;
;;  Revision 1.105  1998/11/11  11:42:30  ehud
;;  Add bzip2 to associations list (.bz2, .tar.bz2, .tbz2, .tb2, .tz2, .tbz)
;;  Substitute-key-definition for many regular keys (e.g. next-line)
;;  Really last revision for 19.34
;;
;;  Revision 1.104  1998/03/15  16:55:37  ehud
;;  Last revision for 19.34
;;
;;  Revision 1.103  1996/03/07  16:49:48  ehud
;;  Added mouse function & menu bar menus
;;
;;  Revision 1.102  1996/02/19  10:28:04  ehud
;;  Emacs 19.30 version
;;
;;  Revision 1.101  1995/09/14  17:58:28  ehud
;;  Changes for ange-ftp (sort 0-3 too)
;;
;;  Revision 1.100  1995/01/19  17:18:33  ehud
;;  SW initial version control for all el's

;;  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 of the License, 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; if not, write to the Free Software
;;  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA


(require 'dired-x)         ;; others dired funcs & vars
(require 'timezone)        ;; for the months

(setq dired-dwim-target t)             ;;double window dired
(setq dired-recursive-deletes 'top)    ;;Ask on top directory only
(setq dired-recursive-copies 'top)     ;;Ask on top directory only

;; a fix for `find-file/ (from files.el) to allow "literal"
;; name (e.g. abc*, def[x], frt??)
;; call with C-u or C-<n> or ESC <n> where n != 1.
(defun find-file (filename &optional wildcards)
  "Edit file FILENAME.
Switch to a buffer visiting file FILENAME,
creating one if none already exists.
Interactively, or if WILDCARDS is non-nil in a call from Lisp,
expand wildcards (if any) and visit multiple files.
To disable wildcards in interactive call use C-u."
  (interactive "FFind file: \np")
;;(describe-variable 'wildcards)
  (and wildcards
      (numberp wildcards)
      (/= wildcards 1)
      (setq wildcards nil))
  (let ((value (find-file-noselect filename nil nil wildcards)))
    (if (listp value)
	(mapcar 'switch-to-buffer (nreverse value))
      (switch-to-buffer value))))


(defvar dired-months-regexp
       (concat "\\("
           (mapconcat (function (lambda (x)
                                   (capitalize (car x))))
                      timezone-months-assoc "\\|")
           "\\)")
  "Regexp for finding the month name in the file line, should be changed
whenever `timezone-months-assoc' changes.")


;; a fix to dired-find-file for symbolic link
;; From: Daniel R. Grayson <dan@math.uiuc.edu>
(defun dired-find-file ()
  "In dired, visit the file or directory named on this line.
Hacked, see help for `dired-find-file-internal'."
       (interactive)
       (dired-find-file-internal 'find-file 'dired))

(defun dired-find-file-literally ()
  "In dired, visit the file or directory named on this line."
       (interactive)
       (dired-find-file-internal 'find-file-literally 'dired))

(defun dired-find-file-other-window ()
  "In dired, visit the file or directory named on this line in other window.
Hacked, see help for `dired-find-file-internal'."
       (interactive)
       (dired-find-file-internal 'find-file-other-window 'dired-other-window))

(defun dired-find-file-other-frame ()
  "In dired, visit the file or directory named on this line in other frame.
New function by Ehud Karni <ehud@unix.simonwiesel.co.il>
See help for `dired-find-file-internal'."
       (interactive)
       (dired-find-file-internal 'find-file-other-frame 'dired-other-frame))

(defun dired-find-file-internal (file-func dir-func)
  "Internal function for dired-find-file & dired-find-file-other-window
1st arg FILE-FUNC - function to call (like 'find-file) for visiting a file.
2nd arg DIR-FUNC - function to call (like 'dired) for browsing as a directory.
If file on this line is a symbolic link and exist visit the symlink (this
   allows the symlink to be an ange-ftp name like /user@remote:/file).
If the symlink does not exist but contains '*' or '?' then the symlink is
   browsed using the DIR-FUNC function.
Hacked by: Ehud Karni <ehud@unix.simonwiesel.co.il> on an original idea
       by: Daniel R. Grayson <dan@math.uiuc.edu>"

       (let* ((file-name (file-name-sans-versions (dired-get-filename) t))
              (SYM-LNK (file-symlink-p file-name)))
           (if SYM-LNK
               (cond
                   ((string-match "^/:[^@:]*@[^@:]*:/" SYM-LNK)    ;check for ange-ftp name
                       (funcall file-func (substring SYM-LNK 2)))  ;Fix for Emacs 21
                   ((file-exists-p SYM-LNK)        ;; Daniel R. Grayson original
                       (funcall file-func SYM-LNK))
                   ((string-match "[\*?]" SYM-LNK) ;; Ehud Karni addition
                       (funcall dir-func SYM-LNK))
                   (t
                       (error "File is a symlink to a nonexistent target")))
               (if (file-exists-p file-name)       ;; Symbolic links does not exist on UNIX
                   (funcall file-func file-name)
                   (error "File no longer exists; type `g' to update Dired buffer")))))


(setq dired-listing-switches "-al")                        ;SW default

(defvar dired-touch-program
           (cond
               ((eq system-type 'ms-dos) nil)              ; nil for dos!
               ((eq system-type 'windows-nt) "touch")      ; use Cygwin32 touch
               (t      "touch-t"))                         ; UNIX - script
               "Name of touch command (usually `touch').") ;changed for DOS

(defvar dired-sort-number 0 "sort requested for this buffer (see help for 'dired-sort-set)")
(make-variable-buffer-local 'dired-sort-number)
(setq-default dired-sort-number 0)             ;; initial value

(add-hook 'dired-after-readin-hook 'dired-sort-after-revert)   ;check for sort after revert

(or (assoc "\\.tgz$" dired-guess-shell-alist-default)
    (setq dired-guess-shell-alist-default
          (cons '("\\.tgz$" "gunzip -qc * | tar xvf -" "gunzip -q") dired-guess-shell-alist-default)))

(or (assoc "\\.bz2$" dired-guess-shell-alist-default)
    (setq dired-guess-shell-alist-default
          (cons '("\\.bz2$" "bunzip2") dired-guess-shell-alist-default)))

;; .tar.bz2, .tbz2, .tb2, .tz2, .tbz,
(or (assoc "\\.t\\(\\(\\(ar\\.\\)?bz\\)2\\|\\([bz]2\\)\\|bz\\)$" dired-guess-shell-alist-default)
    (setq dired-guess-shell-alist-default
          (cons '("\\.t\\(\\(\\(ar\\.\\)?bz\\)2\\|\\([bz]2\\)\\|bz\\)$" "bunzip2 -c * | tar xvf -" "bunzip2")
                dired-guess-shell-alist-default)))

(substitute-key-definition 'next-line        'dired-next-line               dired-mode-map global-map)
(substitute-key-definition 'previous-line    'dired-previous-line           dired-mode-map global-map)
(substitute-key-definition 'delete-char-ehud 'dired-do-delete               dired-mode-map global-map)
(substitute-key-definition 'delete-char      'dired-do-delete               dired-mode-map global-map)
(substitute-key-definition 'ins-toggle       'dired-mark-exchange           dired-mode-map global-map)
(substitute-key-definition 'f3               'dired-view-file               dired-mode-map global-map)
(substitute-key-definition 'S-f3             'dired-view-file-other-window  dired-mode-map global-map)
(substitute-key-definition 'f4               'dired-find-file               dired-mode-map global-map)
(substitute-key-definition 'S-f4             'dired-find-file-other-window  dired-mode-map global-map)
;;  (substitute-key-definition 'SF05             'dired-do-copy                 dired-mode-map global-map)
;;  (substitute-key-definition 'SF06             'dired-do-rename               dired-mode-map global-map)
(substitute-key-definition 'f7               'dired-create-directory        dired-mode-map global-map)
(substitute-key-definition 'downcase-word    'dired-downcase                dired-mode-map global-map)
(substitute-key-definition 'upcase-word      'dired-upcase                  dired-mode-map global-map)

;; keys defined in FK.el
(substitute-key-definition 'PC-down          'dired-next-line               dired-mode-map global-map)
(substitute-key-definition 'PC-up            'dired-previous-line           dired-mode-map global-map)
(substitute-key-definition 'PC-delete        'dired-do-delete               dired-mode-map global-map)
(substitute-key-definition 'PC-insert        'dired-mark-exchange           dired-mode-map global-map)
(substitute-key-definition 'F03              'dired-view-file               dired-mode-map global-map)
(substitute-key-definition 'SF03             'dired-view-file-other-window  dired-mode-map global-map)
(substitute-key-definition 'F04              'dired-find-file               dired-mode-map global-map)
(substitute-key-definition 'SF04             'dired-find-file-other-window  dired-mode-map global-map)
(substitute-key-definition 'F07              'dired-create-directory        dired-mode-map global-map)
(substitute-key-definition 'lower-marked     'dired-downcase                dired-mode-map global-map)
(substitute-key-definition 'uppper-marked    'dired-upcase                  dired-mode-map global-map)



;; dired-next-dirline      ??
;; dired-prev-dirline      ??

(define-key dired-mode-map  "["   'dired-mark-with-regexp)
(define-key dired-mode-map  ";"   'dired-choose-mark-char)
(define-key dired-mode-map  "A"   'dired-man)                  ; instead of N
(define-key dired-mode-map  "N"   'dired-next-marked)
(define-key dired-mode-map  "P"   'dired-previous-marked)
(define-key dired-mode-map  "a"   'dired-find-alternate-file)
(define-key dired-mode-map  "k"   'dired-kill-subdir)
(define-key dired-mode-map  "r"   'dired-find-file-other-frame)
(define-key dired-mode-map  "t"   'dired-do-touch)
(define-key dired-mode-map  "w"   'dired-view-file-other-window)
(define-key dired-mode-map  "z"   'dired-sort-set)
(define-key dired-mode-map "\C-f" 'dired-find-file-literally)
(define-key dired-mode-map "\C-m" 'dired-mark-exchange)
(define-key dired-mode-map "\C-t" 'dired-flaged-total)
(define-key dired-mode-map "\C-v" 'dired-view-file-stop)
(define-key dired-mode-map "\C-_" nil)                         ;allow C-_ to act like C-s

(define-key dired-mode-map "\\"   nil)
(define-key dired-mode-map "\\u"  'dired-upcase)
(define-key dired-mode-map "\\l"  'dired-downcase)
(define-key dired-mode-map "\\d"  'dired-flag-files-regexp)
(define-key dired-mode-map "\\m"  'dired-mark-files-regexp)
(define-key dired-mode-map "\\r"  'dired-do-rename-regexp)
(define-key dired-mode-map "\\C"  'dired-do-copy-regexp)
(define-key dired-mode-map "\\H"  'dired-do-hardlink-regexp)
(define-key dired-mode-map "\\R"  'dired-do-rename-regexp)
(define-key dired-mode-map "\\S"  'dired-do-symlink-regexp)
(define-key dired-mode-map "\\Y"  'dired-do-relsymlink-regexp)


;; mouse operations & popup menues
(define-key dired-mode-map [S-down-mouse-1] 'dired-view-file-other-window) ;; view in other window
(define-key dired-mode-map [drag-mouse-1]   'dired-find-file)              ;; find in this window

(define-key dired-mode-map [mouse-3]       'dired-do-menu)       ;; right mouse key (files operations)
(define-key dired-mode-map [S-mouse-3]     'dired-sort-set-menu) ;; sort dired

;; added operations to menu bar
(define-key dired-mode-map [menu-bar operate touch] (cons "touch (Change date) ..." 'dired-do-touch))
(define-key dired-mode-map [menu-bar mark tot-flag] (cons "Total marked/flaged" 'dired-flaged-total))
(define-key dired-mode-map [menu-bar immediate view-stop] (cons "View group stop" 'dired-view-file-stop))

(define-key dired-mode-map [menu-bar sort] (cons "Sort" (make-sparse-keymap "Sort")))
(let (typ kot nnn lsw
      (srt-opts '(
               (ext   "6" "extens/name" "-alb")
               (size  "5" "size/name  " "-alb")
               (owner "4" "owner/name " "-alb")
               (ctrl  "3" "chmod time " "-albtc")
               (acct  "2" "access time" "-albtu")
               (modt  "1" "mod time   " "-albt")
               (name  "0" "name       " "-alb"))))
       (while srt-opts
           (setq kot (car srt-opts))
           (setq srt-opts (cdr srt-opts))
           (setq typ (vector 'menu-bar 'sort (car kot)))
           (setq nnn (nth 1 kot))
           (setq lsw (nth 3 kot))
           (setq kot (concat "sort by " (nth 2 kot)))
           (define-key dired-mode-map typ (cons (concat kot " " lsw) (make-sparse-keymap kot)))
           (setq typ (vector (aref typ 0) (aref typ 1) (aref typ 2) 'no-rvrs))
           (define-key dired-mode-map typ (cons "  -NO-  subdirs/reverse" (concat "1" nnn "z")))
           (aset typ 3 'no-nrml)
           (define-key dired-mode-map typ (cons "  -NO-  subdirs/normal" (concat nnn "z")))
           (aset typ 3 'inc-rvrs)
           (define-key dired-mode-map typ (cons "include subdirs/reverse" (concat "11" nnn "z")))
           (aset typ 3 'inc-nrml)
           (define-key dired-mode-map typ (cons "include subdirs/normal" (concat "10" nnn "z")))))


(defun dired-choose-mark-char ()
  "Change mark character interactivly."
  (interactive)
       (setq dired-marker-char
               (aref (concat (read-string "Enter new mark character: "
                                   (char-to-string dired-marker-char)) " ") 0)))


(defun dired-do-menu (event)
  "Pop up a menu of operation on current file in dired buffer"
  (interactive "e")
       (save-window-excursion
           (let ((mpp (mouse-position))                    ;;save mouse starting position
                 (do-cmd (x-popup-menu t '("type select"
                       ("dired do options"
                           ("copy file       " . dired-do-copy)
                           ("delete file     " . dired-do-delete)
                           ("chgrp file      " . dired-do-chgrp)
                           ("hardlink file   " . dired-do-hardlink)
                           ("chmod file      " . dired-do-chmod)
                           ("chown file      " . dired-do-chown)
                           ("rename/move file" . dired-do-rename)
                           ("symlink file    " . dired-do-symlink)
                           ("touch file      " . dired-do-touch)
                           ("compress file   " . dired-do-compress)
                           ("downcase name   " . dired-downcase)
                           ("upcase name     " . dired-upcase))))))
               (set-mouse-position (car mpp) (car (cdr mpp)) (cdr (cdr mpp)))
               (if do-cmd
                   (save-excursion
                       (mouse-set-point event)
                       (if (dired-get-filename nil t)  ;;check to see if file on this line
                           (funcall do-cmd)))))))


(defun dired-do-touch (&optional arg)                      ;new (19) version
  "touch the marked (or next ARG) files."
  (interactive "P")
  (dired-do-chxxx (concat
                   "date & TIME ("
                   (if (eq 'w32 window-system)
                       "MMDDhhmm[[CC][YY][.ss])"   ;; Windows NT/95 system (20.x)
                       "[[CC][YY]MMDDhhmm.[ss])")) ;; UNIX
                  dired-touch-program 'touch arg))

(defun dired-find-alternate-file (&optional as-directory)
  "In dired, visit this file or directory instead of dired buffer."
  (interactive "P")
       (not-modified)
       (if as-directory
           (ek-find-alternate-file nil as-directory)
           (ek-find-alternate-file (dired-get-filename))))


(defun dired-flaged-total ()
  "In dired, output total of flged files in minibuffer"
       (interactive)
       (let (tot-list mrk cnt flng msg)
           (save-excursion
               (goto-char (point-min))
               (while (not (eobp))
                   (and (/= (setq mrk (char-after (point))) ? )
                        (/= mrk ?\n )
                        (setq flng (dired-get-file-length))
                       (let  ((new-list nil)
                              (ent (car tot-list))
                              (tot-mrk nil)
                              (tot-cnt nil)
                              (tot-tot nil))
                           (while tot-list
                               (setq tot-list (cdr tot-list))
                               (setq tot-mrk (nth 0 ent))
                               (setq tot-cnt (nth 1 ent))
                               (setq tot-tot (nth 2 ent))
                               (if (= tot-mrk mrk)
                                   (progn
                                        (setq ent (list tot-mrk (1+ tot-cnt) (+ tot-tot flng)))
                                        (setq new-list (append new-list (list ent) tot-list))
                                        (setq tot-list nil)
                                        (setq mrk nil))
                                   (setq new-list (append new-list (list ent))))
                               (setq ent (car tot-list)))
                           (if mrk
                               (setq tot-list (append new-list (list (list mrk 1 flng))))
                               (setq tot-list new-list))))
                       (forward-line 1))
;;         (describe-variable 'tot-list)
           (while tot-list
               (setq mrk (car tot-list))
               (setq tot-list (cdr tot-list))
               (setq cnt  (nth 1 mrk))
               (setq flng (nth 2 mrk))
               (setq mrk  (nth 0 mrk))
               (and mrk
                   (setq msg (format "%s %d files (%d bytes) marked %c"
                                   (if msg (concat msg ", ") "") cnt flng mrk))))
           (if msg
               (message msg)
               (message "No flaged/marked files")))))


(defun dired-get-file-extension (file-name)
  "In dired, return extension of FILE-NAME. Extension is defined as the
substring from the rightmost `.' to the end, if no point return \"\"."
       (if (string-match "\\." file-name)
           (let* ((lng (length file-name))
                  (ix lng)
                  (ch 0)
                  (ext ""))
               (while (not (= ch ?.))
                  (setq ix (1- ix))
                  (setq ch (aref file-name ix))
                  (setq ext (concat (list ch) ext)))
               ext)
           ""))

(defun dired-get-file-length ()
  "In dired, return length of file mentioned on this line.
Return 0 if there is no file on this line."
       (string-to-int (dired-get-file-length-string)))

(defun dired-get-file-length-string ()
  "In dired, return length of file mentioned on this line.
Return "0" if there is no file on this line."
       (let ((length "0") bol pos)
           (save-excursion
               (beginning-of-line)
               (setq bol (point))
               (end-of-line)
               (if (re-search-backward
                       (concat "[ ]" dired-months-regexp) bol t)
                   (progn
                       (setq pos (point))
                       (skip-chars-backward "^ " bol)
                       (setq length (buffer-substring (point) pos))))
               length)))



(defun dired-get-file-owner ()
  "In dired, return owner (1st field after number of links)
Return "" if there is no file on this line."
       (let ((owner " ")
             (pos (point))
             (eol (progn (end-of-line) (point))))
           (beginning-of-line)
           (and (re-search-forward "[ ][^ ]*[-stx][ ]" eol t)
                (re-search-forward "[0-9][ ]" eol t)
                (setq owner (buffer-substring (point) (search-forward " "))))
           (goto-char pos)
           owner))

(defun dired-get-file-time (&optional arg)
  "In dired, return file time as exactly 10 character string
optional ARG specify what time: 1-modify (def), 2-access, 3-control."
       (or arg (setq arg 1))                   ; def value
       (let ((ftst "          ")               ;10 spaces
             (tp (cond
                   ((= arg 2)  4)
                   ((= arg 3)  6)
                   (t          5)))
             (fn (dired-get-filename t t)))    ;file name/time
           (and fn
               (if (or (member system-type '(windows-nt dos))
                       (and (boundp 'ftp-on) ftp-on))
                   (save-excursion
                       (beginning-of-line)
                       (re-search-forward
                           (concat dired-months-regexp "[ ]+[0-9]+") nil t)
                       (let* ((beg (match-beginning 0))
                              (end (match-end 0))
                              (ymf (+ 0.032786885 (/ (float (car (current-time))) 40.12756)))  ; Year & month in float
                              (YR  (format "%3d" (+ 170 (truncate (/ ymf 12)))))           ; curent year 1xx/2xx
                              (HM   "0000")                                                ; def hou.minute
                              (MNT (cdr-safe (assoc (upcase (buffer-substring beg (+ 3 beg)))
                                          timezone-months-assoc)))                         ; month number or nil (unknown)
                              (DAY (string-to-number (buffer-substring (- end 2) end) 10)) ; day (number)
                             )
                           (or MNT (setq MNT 0))           ; convert unknown month to 0
                           (setq ymf (1+ (% (truncate ymf) 12)))   ; current month 1-12
                           (skip-chars-forward " ")        ; start of YEAR or HH:MM
                           (setq beg (point))
                           (skip-chars-forward "^ ")       ; end of YEAR or HH:MM
                           (setq end (point))
                           (if (= (- end beg) 4)           ; 4 digits - YEAR 19xx/20xx
                               (setq YR (concat
                                           (buffer-substring beg (1+ beg))
                                           (buffer-substring (- end 2) end)))
                               (setq HM (concat
                                           (buffer-substring beg (+ beg 2))
                                           (buffer-substring (- end 2) end))
                                     YR (if (<= MNT ymf) YR                ;leave year as is if month <= current
                                            (format "%d" (1- (string-to-number YR))))));decrease 1 otherwise
                           (setq DAY (format "%d" (+ 100 (* MNT 50) DAY))) ; month*50 + day + 100 (3 digits)
                           (setq ftst (concat YR DAY HM))))                ; 3d-3d-4d (10 chars)
               (progn
                   (setq fn (nth tp (file-attributes fn)))                 ; get file time as (hi16bit lo16bit)
                   (setq ftst (format "%d%d" (+ 10000 (or (car fn) 0))     ; convert each to exactly 5
                                       (+ 10000 (or (nth 1 fn) 0)))))))    ; decimal digits
           ftst))

(defun dired-mark-exchange (&optional arg)
  "In dired, invert the mark for the current file. If flaged for delete (D)
or marked with other mark or no file in this line do nothing.
With arg, repeat over several lines."
       (interactive "p")
       (or arg (setq arg 1))
       (dired-repeat-over-lines arg 'dired-mark-exchange-1))

(defun dired-mark-exchange-1 ()
  "In dired, invert the mark for the current line's file for operation
If marked with other mark or no file in this line do nothing."
       (let (buffer-read-only
             (pos (point))
             (fn (dired-get-filename 'no-dir t))
             (ch (progn (beginning-of-line) (char-after (point)))))
           (and fn
                (not (string= fn "."))
                (not (string= fn ".."))
                (if (= ch ? )              ;space ?
                   (subst-char-in-region (point) (1+ (point)) ?   dired-marker-char)
                   (subst-char-in-region (point) (1+ (point)) dired-marker-char ?  )))
           (goto-char pos)))


(defun dired-mark-with-regexp ()
  "In dired mark (flag or unmarked) all files containing a REGEXP with MARK
asks user (interactivly) for the mark and for the regular experression.
From a program use dired-mark-files-regexp instead."
       (interactive)
       (let ((mark (aref (concat (read-string "Enter character to mark with: "
                                      (char-to-string dired-marker-char)) " ") 0))
             (regexp (dired-read-regexp "Mark all files containing (regexp): ")))
           (dired-mark-files-regexp regexp mark)))


(defun dired-next-marked (arg)
  "Go to next ARG marked file (position at filename)."
  (interactive "p")
       (or arg (setq arg 1))
       (if (re-search-forward "^[^ \n\t]" nil t arg)
           (dired-move-to-filename)
           (message "no next (%d) marked files" arg)))


(defun dired-previous-marked (arg)
  "Go to previous ARG marked file (position at filename)."
  (interactive "p")
       (or arg (setq arg 1))
       (let ((pos (point)))
           (beginning-of-line)
           (if (re-search-backward "^[^ \n\t]" nil t arg)
               (dired-move-to-filename)
               (progn
                   (goto-char pos)
                   (message "no previous (%d) marked files" arg)))))


(defun dired-restore-8bit-chars ()
"Replace \[23]xx (4 chars) with their real value (1 char) in the whole buffer"
       (let ((pos (point-marker))
             buffer-read-only
             rplc
             )
           (goto-char (point-min))
           (while (re-search-forward "\\\\[23][0-7][0-7]" nil t)
               (setq rplc (read (concat "\""
                                        (buffer-substring (match-beginning 0) (match-end 0))
                                        "\"")))
               (and (eq 'w32 window-system)       ;; Windows NT/95 system (20.x)
                    (string-lessp rplc "\233")
                    (aset rplc 0 (+ 96 (aref rplc 0))))    ;;windows erorr in handling Hebrew names
               (replace-match rplc t t))
           (goto-char (point-min))
           (while (search-forward "\\ " nil t)
               (replace-match " " t t))
           (goto-char pos)))

(defun dired-sort-after-revert () "sort the buffer each time its re-read or inserted"
       (let* ((bdir (< dired-sort-number 0))                   ;begin with dirs
              (rvrs (>= (mod (abs dired-sort-number) 100) 10)) ;revers switch
              (o-s  (mod (abs dired-sort-number) 10))          ;0-6 sort requested
              (ftp-on (string-match "@.*:"                     ;ange-ftp on switch
                           (if (listp dired-directory)
                               (car dired-directory)
                               dired-directory))))
           (dired-restore-8bit-chars)          ; convert Hebrew to 8bit
           (if bdir                            ; special dirs
               (dired-sort-ek rvrs o-s bdir)   ; Yes, use my sort
               (and (or
                       (and (member system-type '(windows-nt dos))
                            (>= o-s 1))                ; sort of any type in MSDOS
;;;;   U N I X  -  (with ange ftp) ==============================
                       (>= o-s 4)              ; sort by owner / size / extension (unix)
                       ftp-on)                 ; any (ange-ftp)
                    (dired-sort-ek rvrs o-s)))); sort by any needed sort (0-6)
       (set-buffer-modified-p nil))            ; ignore modification done by sort

(defun dired-sort-ek (reverse sub-sort &optional bdir)
  "sort the buffer (REVERSED) according to SUB-SORT:
0-name, 1,2,3-sort by time/name, 4-size/name,  5-owner/name,  6-extension/name.
Optional BDIR - sort directories at beging by name."
       (let ((sv-fn (dired-get-filename 'no-dir t))
             (sv-fn-ful (dired-get-filename t t))
             (sv-pos (point-marker))
             (sv-col (column-no))
             (sbul buffer-undo-list)       ;; undo list
             buffer-read-only
             (fsdch "531")                 ;; file/symbolic/dir char
             (diron 0)                     ;; sub type - file/symbolic/dir - 0/1/2
             ds-chk                        ;; dir/symbolic check
             fn beg end sv-end)
           (and (> sub-sort 0)
                (< sub-sort 4)
                (setq reverse (not reverse)))
           (and bdir
                reverse
                (setq fsdch "579"))
           (goto-char (point-min))
           (while (not (eobp))
               (while (and (not (eobp)) (not (dired-get-filename 'no-dir t)))
                   (forward-line 1))                   ;;search 1st line of directory to sort
               (beginning-of-line)
               (setq beg (point))
               (while (and (not (eobp))
                           (setq fn (dired-get-filename 'no-dir t)))
                   (beginning-of-line)
                   (and bdir fn
                       (setq diron 0
                             ds-chk (if (member system-type '(windows-nt dos)) ;; on W9x/DOS use the bash attributes
                                       (cond
                                           ((looking-at ". d") t)          ;;directory
                                           ((looking-at ". l") "symlink")  ;;symbolic link
                                           (t                  nil))
                                       (nth 0 (file-attributes fn))))     ; exit from and for regular files
                       (setq diron
                             (if (or (eq ds-chk t)
                                     (string-equal fn "..")
                                     (string-equal fn "."))
                                 2 1)))
                   (insert (aref fsdch diron)
                           (cond
                               ((> diron 0)
                                   (and reverse
                                       (setq diron (length fn))
                                       (setq fn (concat fn "ÿÿ"))
                                       (while (> diron 0)
                                           (setq diron (1- diron))
                                           (setq ds-chk (- 287 (% (aref fn diron) 256)))
                                           (if (> ds-chk 255) (setq ds-chk 255))
                                           (aset fn diron ds-chk)))
                                                       "")         ;; ensure add nothing
                               ((= sub-sort 0)         "")         ;; we realy need only the name
                               ((< sub-sort 4)                     ;; 1, 2 or 3 (all the same on pc)
                                       (dired-get-file-time sub-sort))
                               ((= sub-sort 4)
                                       (dired-get-file-owner))
                               ((= sub-sort 5)
                                       (substring (concat "         " (dired-get-file-length-string)) -10))
                               ((= sub-sort 6)
                                       (dired-get-file-extension fn))
                               (t      ""))
                           "     "
                           fn
                           "            ÝÞß")
                   (forward-line 1))
               (setq sv-end (point-marker))
               (setq end (point))
               (sort-lines reverse beg end)
               (goto-char beg)
               (while (< (point-marker) sv-end)
                   (delete-region (point)
                                  (search-forward " ÝÞß"))
                   (forward-line 1))
               (goto-char sv-end))
           (setq buffer-undo-list sbul)    ;; restore undo
           (goto-char sv-pos)
           (if sv-fn
               (progn
                   (goto-char (point-min))
                   (while (not (string-equal sv-fn-ful (dired-get-filename t t)))
                       (search-forward sv-fn)
                       (end-of-line))
                   (goto-col sv-col)))))


(defun dired-sort-set-menu (event)
  "Pop up a menu of sort-options for this dired buffer
This switches buffers in the window that you clicked on,
and selects that window."
  (interactive "e")
       (let (rsb                                           ; reverse & sub dir option
             (srt (x-popup-menu t '("type select"
                   ("dired sort options"
                       ("normal (sort by name)          " . 0)
                       ("sort by modification time      " . 1)
                       ("sort by access time            " . 2)
                       ("sort by control (chmod ..) time" . 3)
                       ("sort by owner / name           " . 4)
                       ("sort by size / name            " . 5)
                       ("sort by extension / name       " . 6))))))    ;;major sort option
           (and srt
               (setq rsb (x-popup-menu t '("rsb"
                   ("sort order / subdirectory"
                       ("ls order, NO sub directories" . 0)
                       ("-r order, NO sub directories" . 10)
                       ("ls order,  + sub directories " . 100)
                       ("-r order,  + sub directories " . 110)))))
               (setq srt (+ srt rsb))
               (dired-sort-set srt))))


(defun dired-sort-set (&optional arg)
  "Sort current dired buffer (and reread),
 and change dired-listing-switches according to argument:
0/9 -sort by name (normal)             - al
 1 - sort by modification time         - alt   PC:-al
 2 - sort by access time               - altu  PC:-al
 3 - sort by control (chmod ..) time   - altc  PC:-al
 4 - sort by owner / name              - al
 5 - sort by size / name               - al
 6 - sort by extension / name          - al
 Add   10 for reverse sorting        (r switch to ls)
 Add  100 for subdirecotry inclusion (R switch to ls)
 Add 1000 for listing direcotries at begging by name"
    (interactive "P")
       (or arg
           (save-window-excursion
               (describe-function 'dired-sort-set)
               (setq arg (string-to-int (read-string
                   "Enter new sort value for this Dired: " (format "%s" dired-sort-number))))
               (kill-buffer "*Help*")))
       (let* ((a-arg (abs arg))
              (Subdir (if (< a-arg 100) "" "R"))
              (revers (if (< (mod a-arg 100)  10) "" "r"))
              (switch (mod a-arg 10))
              (d-l-s ""))
           (cond
               ((member system-type '(windows-nt dos))
                   (setq d-l-s "-al"))             ;; it always "-al" in MSDOS/windows
               ((or (= switch 0)                   ;; by name
                    (= switch 9))                  ;; 0 / 9
                   (setq d-l-s "-al"))
               ((= switch 1)
                   (setq d-l-s "-alt"))
               ((= switch 2)
                   (setq d-l-s "-altu"))
               ((= switch 3)
                   (setq d-l-s "-altc"))
               ((<= switch 6)
                   (setq d-l-s "-al"))
               (t
                   (error "arg to dired-sort-set is %d - must be [01][01][0-6]" arg)))
           (setq-default dired-sort-number arg)    ;; make it default for new dirs
           (setq dired-sort-number arg)
           (setq dired-actual-switches (setq dired-listing-switches (concat d-l-s revers Subdir)))
           (dired-sort-set-modeline)
           (revert-buffer)))


(defun dired-sort-set-modeline () "Dired sub mode (sort & Subdirectory options)"
       (let ((modec "Dired by ")
             (dsn (abs dired-sort-number))
             (case-fold-search))
           (if (string-match "t" dired-actual-switches)
               (progn
                   (cond
                       ((string-match "u" dired-actual-switches)
                               (setq modec (concat modec "access")))
                       ((string-match "c" dired-actual-switches)
                               (setq modec (concat modec "control")))
                       (t      (setq modec (concat modec "modify"))))
                   (setq modec (concat modec " time")))
               (progn
                   (cond
                       ((= (mod dsn 10) 4)
                               (setq modec (concat modec "owner/")))
                       ((= (mod dsn 10) 5)
                               (setq modec (concat modec "size/")))
                       ((= (mod dsn 10) 6)
                               (setq modec (concat modec "ext/"))))
                   (setq modec (concat modec "name"))))
           (and (string-match "r" dired-actual-switches)
                (setq modec (concat modec " reversed")))
           (and (string-match "R" dired-actual-switches)
                (setq modec (concat modec " (SubDir)")))
           (setq mode-name modec))
           (force-mode-line-update))


(defun dired-view-file (&optional o-w)
  "In dired, visit the file (all flaged files) in read only (view) mode.
with optional paramter non nil OTHER-WINDOW view it in other window."
  (interactive)
       (let ((view-file-list (dired-get-marked-files))
             (dired-view-name ""))
           (if view-file-list
               (while view-file-list
;;                 (setq dired-view-name (file-name-nondirectory (car view-file-list)))
                   (setq dired-view-name (car view-file-list))
                   (setq view-file-list (cdr view-file-list))
                   (if o-w
                       (find-file-read-only-other-window dired-view-name)
                       (find-file-read-only dired-view-name))
                   (recursive-edit)
                   (setq o-w nil))
               (if o-w
                   (find-file-read-only-other-window (dired-get-filename))
                   (find-file-read-only (dired-get-filename))))))

(defun dired-view-file-other-window ()
 "Visit the file (all flaged files) with read only (view) mode in other window."
  (interactive)
       (dired-view-file t))        ;use dired view file with other window set

(defun dired-view-file-stop ()
  "When In dired and viewing a group of files, stop after current file."
  (interactive)
       (and (boundp 'view-file-list)
            (setq view-file-list nil))
       (and (boundp 'dired-view-name)
            (pop-to-buffer dired-view-name)
            (kill-and-exit)))

;; ==================== W32 added functions (Open/Print) ====================

(if (eq system-type 'windows-nt)
    (progn
       (defun dired-w32-open ()           ; open by W32 associated OPEN
          "Open by the associated w32 program."
           (interactive)
               (w32-shell-execute "open" (dired-replace-in-string "/" "\\" (dired-get-filename))))

       (defun dired-w32-print ()          ; print by W32 associated PRINT
          "Print by the associated w32 program."
           (interactive)
               (w32-shell-execute "print" (dired-replace-in-string "/" "\\" (dired-get-filename))))

       (substitute-key-definition 'Alt-O      'dired-w32-open  dired-mode-map global-map)
       (substitute-key-definition 'Alt-P      'dired-w32-print dired-mode-map global-map)

     ))

;;============================= end of ekdired.el =============================