/[cmucl]/src/hemlock/diredcoms.lisp
ViewVC logotype

Diff of /src/hemlock/diredcoms.lisp

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

revision 1.2 by ram, Fri Jul 13 15:11:36 1990 UTC revision 1.3 by ram, Fri Feb 11 21:52:56 1994 UTC
# Line 1  Line 1 
1  ;;; -*- Log: hemlock.log; Package: Hemlock -*-  ;;; -*- Log: hemlock.log; Package: Hemlock -*-
2  ;;;  ;;;
3  ;;; **********************************************************************  ;;; **********************************************************************
4  ;;; This code was written as part of the Spice Lisp project at  ;;; This code was written as part of the CMU Common Lisp project at
5  ;;; Carnegie-Mellon University, and has been placed in the public domain.  ;;; Carnegie Mellon University, and has been placed in the public domain.
6  ;;; Spice Lisp is currently incomplete and under active development.  ;;; If you want to use this code or any part of CMU Common Lisp, please contact
7  ;;; If you want to use this code or any part of Spice Lisp, please contact  ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
8  ;;; Scott Fahlman (FAHLMAN@CMUC).  ;;;
9    (ext:file-comment
10      "$Header$")
11    ;;;
12  ;;; **********************************************************************  ;;; **********************************************************************
13  ;;;  ;;;
14  ;;; Simple directory editing support.  ;;; Simple directory editing support.
# Line 331  Line 334 
334      (editor-error "Not in Dired buffer."))      (editor-error "Not in Dired buffer."))
335    (let ((dirs (pathname-directory    (let ((dirs (pathname-directory
336                 (dired-info-pathname (value dired-information)))))                 (dired-info-pathname (value dired-information)))))
     (declare (simple-vector dirs))  
337      (dired-command nil      (dired-command nil
338                     (make-pathname                     (truename (make-pathname :directory (nconc dirs '(:UP)))))))
                     :device :absolute  
                     :directory (subseq dirs 0 (1- (length dirs)))))))  
339    
340    
341    
# Line 434  Line 434 
434  (defcommand "Dired Next File" (p)  (defcommand "Dired Next File" (p)
435    "Moves to next undeleted file."    "Moves to next undeleted file."
436    "Moves to next undeleted file."    "Moves to next undeleted file."
   (declare (ignore p))  
437    (unless (dired-line-offset (current-point) (or p 1))    (unless (dired-line-offset (current-point) (or p 1))
438      (editor-error "Not enough lines.")))      (editor-error "Not enough lines.")))
439    
440  (defcommand "Dired Previous File" (p)  (defcommand "Dired Previous File" (p)
441    "Moves to previous undeleted file."    "Moves to previous undeleted file."
442    "Moves to next undeleted file."    "Moves to next undeleted file."
   (declare (ignore p))  
443    (unless (dired-line-offset (current-point) (or p -1))    (unless (dired-line-offset (current-point) (or p -1))
444      (editor-error "Not enough lines.")))      (editor-error "Not enough lines.")))
445    
# Line 760  Line 758 
758                (push (cons pathname (file-write-date pathname))                (push (cons pathname (file-write-date pathname))
759                      marked-files)))))))                      marked-files)))))))
760    
761  ;;; ARRAY-ELEMENT-FROM-MARK counts the lines between it and the beginning  ;;; ARRAY-ELEMENT-FROM-MARK -- Internal Interface.
762  ;;; of the buffer.  The number is used to index vector as if each line  ;;;
763  ;;; mapped to an element starting with the zero'th element (lines are  ;;; This counts the lines between it and the beginning of the buffer.  The
764  ;;; numbered starting at 1).  ;;; number is used to index vector as if each line mapped to an element
765    ;;; starting with the zero'th element (lines are numbered starting at 1).
766    ;;; This must use AREF since some modes use this with extendable vectors.
767  ;;;  ;;;
768  (defun array-element-from-mark (mark vector  (defun array-element-from-mark (mark vector
769                                  &optional (error-msg "Invalid line."))                                  &optional (error-msg "Invalid line."))
770    (when (blank-line-p (mark-line mark)) (editor-error error-msg))    (when (blank-line-p (mark-line mark)) (editor-error error-msg))
771    (svref vector    (aref vector
772           (1- (count-lines (region           (1- (count-lines (region
773                             (buffer-start-mark (line-buffer (mark-line mark)))                             (buffer-start-mark (line-buffer (mark-line mark)))
774                             mark)))))                             mark)))))
# Line 787  Line 787 
787  ;;; one directory.  ;;; one directory.
788  ;;;  ;;;
789  (defun dired-directorify (pathname)  (defun dired-directorify (pathname)
790    (let ((directory (lisp::predict-name pathname t)))    (let ((directory (ext:unix-namestring pathname)))
791      (if (directoryp directory)      (if (directoryp directory)
792          directory          directory
793          (pathname (concatenate 'simple-string (namestring directory) "/")))))          (pathname (concatenate 'simple-string (namestring directory) "/")))))

Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3

  ViewVC Help
Powered by ViewVC 1.1.5