climacs-cvs May 2006

climacs-cvs@common-lisp.net

3 participants
68 discussions

[climacs-cvs] CVS climacs
by dmurray 06 May '06

06 May '06

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv11198 Modified Files: file-commands.lisp Log Message: Made local-options parsing a bit more robust, removed dependence on split-sequence, and added command Reparse Attribute List (a la Zmacs). Changed terminology from 'local options' to 'attribute line/list'. --- /project/climacs/cvsroot/climacs/file-commands.lisp 2006/05/06 06:27:14 1.11 +++ /project/climacs/cvsroot/climacs/file-commands.lisp 2006/05/06 11:41:57 1.12 @@ -129,20 +129,8 @@ :key #'climacs-syntax::syntax-description-pathname-types)) 'basic-syntax)) -(defun parse-local-options-line (line) - "Parse the local options line `line' and return an alist - mapping options to values. All option names will be coerced to - uppercase. `Line' must be stripped of the leading and - terminating -*- tokens." - (loop for pair in (split-sequence:split-sequence #\; line) - when (find #\: pair) - collect (destructuring-bind (key value) - (loop for elem in (split-sequence:split-sequence #\: pair) - collecting (string-trim " " elem)) - (list (string-upcase key) value)))) - -(defun evaluate-local-options (buffer options) - "Evaluate the local options `options' and modify `buffer' as +(defun evaluate-attributes (buffer options) + "Evaluate the attributes `options' and modify `buffer' as appropriate. `Options' should be an alist mapping option names to their values." ;; First, check whether we need to change the syntax (via the SYNTAX @@ -152,8 +140,8 @@ (let ((specified-syntax (syntax-from-name (second (find-if #'(lambda (name) - (or (string= name "SYNTAX") - (string= name "MODE"))) + (or (string-equal name "SYNTAX") + (string-equal name "MODE"))) options :key #'first))))) (when specified-syntax @@ -163,32 +151,74 @@ ;; Now we iterate through the options (discarding SYNTAX and MODE ;; options). (loop for (name value) in options - unless (or (string= name "SYNTAX") - (string= name "MODE")) + unless (or (string-equal name "SYNTAX") + (string-equal name "MODE")) do (eval-option (syntax buffer) name value))) -(defun evaluate-local-options-line (buffer) - "Evaluate the local options line of `buffer'. If `buffer' does - not have a local options line, this function is a no-op." - ;; This could be simplified a bit by using regexps. - (let* ((beginning-mark (beginning-of-buffer - (clone-mark (point buffer)))) - (end-mark (end-of-line (clone-mark beginning-mark))) - (line (buffer-sequence buffer (offset beginning-mark) (offset end-mark))) - (first-occurence (search "-*-" line)) - (second-occurence - (when first-occurence - (search "-*-" line :start2 (1+ first-occurence))))) - (when (and first-occurence - second-occurence) - ;; Strip away the -*-s. - (let ((cleaned-options-line (coerce (subseq line - (+ first-occurence 3) - second-occurence) - 'string))) - (evaluate-local-options - buffer - (parse-local-options-line cleaned-options-line)))))) +(defun split-attribute (string char) + (let (pairs) + (loop with start = 0 + for ch across string + for i from 0 + when (eql ch char) + do (push (string-trim '(#\Space #\Tab) (subseq string start i)) + pairs) + (setf start (1+ i)) + finally (unless (>= start i) + (push (string-trim '(#\Space #\Tab) (subseq string start)) + pairs))) + (nreverse pairs))) + +(defun split-attribute-line (line) + (mapcar (lambda (pair) (split-attribute pair #\:)) + (split-attribute line #\;))) + +(defun get-attribute-line (buffer) + (let ((scan (beginning-of-buffer (clone-mark (point buffer))))) + ;; skip the leading whitespace + (loop until (end-of-buffer-p scan) + until (not (whitespacep (object-after scan))) + do (forward-object scan)) + ;; stop looking if we're already 1,000 objects into the buffer + (unless (> (offset scan) 1000) + (let ((start-found + (loop with newlines = 0 + when (end-of-buffer-p scan) + do (return nil) + when (eql (object-after scan) #\Newline) + do (incf newlines) + when (> newlines 1) + do (return nil) + do (forward-object scan) + until (looking-at scan "-*-") + finally (return t)))) + (when start-found + (let ((line (buffer-substring buffer + (offset scan) + (offset (end-of-line (clone-mark scan)))))) + (when (>= (length line) 6) + (let ((end (search "-*-" line :from-end t :start2 3))) + (when end + (string-trim '(#\Space #\Tab) (subseq line 3 end))))))))))) + +(defun evaluate-attributes-line (buffer) + (evaluate-attributes + buffer + (split-attribute-line (get-attribute-line buffer)))) + +(define-command (com-reparse-attribute-list :name t :command-table buffer-table) () + "Reparse the current buffer's attribute list. +An attribute list is a line of keyword-value pairs, each keyword separated +from the corresponding value by a colon. If another keyword-value pair +follows, the value should be terminated by a colon. The attribute list +is surrounded by '-*-' sequences, but the opening '-*-' need not be at the +beginning of the line. Climacs looks for the attribute list +on the first or second non-blank line of the file. + +An example attribute-list is: + +;; -*- Syntax: Lisp; Base: 10 -*- " + (evaluate-attributes-line (buffer (current-window)))) ;; Adapted from cl-fad/PCL (defun directory-pathname-p (pathspec)

1 0

[climacs-cvs] CVS climacs
by dmurray 06 May '06

06 May '06

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv6143 Modified Files: pane.lisp packages.lisp file-commands.lisp Log Message: Changed backup behaviour. Now makes emacs-style versioned backups (foo.lisp~42~) once per session. Also checks to see if the file has changed on disk when saving and reverting. --- /project/climacs/cvsroot/climacs/pane.lisp 2006/04/23 19:37:58 1.37 +++ /project/climacs/cvsroot/climacs/pane.lisp 2006/05/06 06:27:14 1.38 @@ -227,8 +227,10 @@ (defparameter +climacs-textual-view+ (make-instance 'climacs-textual-view)) -(defclass filepath-mixin () - ((filepath :initform nil :accessor filepath))) +(defclass file-mixin () + ((filepath :initform nil :accessor filepath) + (file-saved-p :initform nil :accessor file-saved-p) + (file-write-time :initform nil :accessor file-write-time))) ;(defgeneric indent-tabs-mode (climacs-buffer)) @@ -238,7 +240,7 @@ (defclass extended-binseq2-buffer (read-only-mixin binseq2-buffer p-undo-mixin abbrev-mixin) () (:documentation "Extensions accessible via marks.")) -(defclass climacs-buffer (delegating-buffer filepath-mixin name-mixin) +(defclass climacs-buffer (delegating-buffer file-mixin name-mixin) ((needs-saving :initform nil :accessor needs-saving) (syntax :accessor syntax) (point :initform nil :initarg :point :accessor point) --- /project/climacs/cvsroot/climacs/packages.lisp 2006/05/01 18:36:41 1.91 +++ /project/climacs/cvsroot/climacs/packages.lisp 2006/05/06 06:27:14 1.92 @@ -145,7 +145,8 @@ (defpackage :climacs-pane (:use :clim-lisp :clim :climacs-buffer :climacs-base :climacs-abbrev :climacs-syntax :flexichain :undo) - (:export #:climacs-buffer #:needs-saving #:filepath + (:export #:climacs-buffer #:needs-saving + #:filepath #:file-saved-p #:file-write-time #:read-only-p #:buffer-read-only #:climacs-pane #:point #:mark #:clear-cache --- /project/climacs/cvsroot/climacs/file-commands.lisp 2006/05/04 18:53:52 1.10 +++ /project/climacs/cvsroot/climacs/file-commands.lisp 2006/05/06 06:27:14 1.11 @@ -212,7 +212,7 @@ (switch-to-buffer existing-buffer) (let ((buffer (make-buffer)) (pane (current-window))) - ;; Clear the panes cache; otherwise residue from the + ;; Clear the pane's cache; otherwise residue from the ;; previously displayed buffer may under certain ;; circumstances be displayed. (clear-cache pane) @@ -223,6 +223,7 @@ (when (probe-file filepath) (with-open-file (stream filepath :direction :input) (input-from-stream stream buffer 0)) + (setf (file-write-time buffer) (file-write-date filepath)) ;; A file! That means we may have a local options ;; line to parse. (evaluate-local-options-line buffer)) @@ -242,7 +243,7 @@ (defun directory-of-buffer (buffer) "Extract the directory part of the filepath to the file in BUFFER. - If BUFFER does not have a filepath, the path to the users home + If BUFFER does not have a filepath, the path to the user's home directory will be returned." (make-pathname :directory @@ -324,6 +325,8 @@ (defun set-visited-file-name (filename buffer) (setf (filepath buffer) filename + (file-saved-p buffer) nil + (file-write-time buffer) nil (name buffer) (filepath-filename filename) (needs-saving buffer) t)) @@ -371,15 +374,51 @@ (display-message "~A is a directory name." filepath) (beep)) ((probe-file filepath) + (unless (check-file-times buffer filepath "Revert" "reverted") + (return-from com-revert-buffer)) (erase-buffer buffer) (with-open-file (stream filepath :direction :input) (input-from-stream stream buffer 0)) - (setf (offset (point pane)) - (min (size buffer) save))) + (setf (offset (point pane)) (min (size buffer) save) + (file-saved-p buffer) nil)) (t (display-message "No file ~A" filepath) (beep)))))) +(defun extract-version-number (pathname) + "Extracts the emacs-style version-number from a pathname." + (let* ((type (pathname-type pathname)) + (length (length type))) + (when (and (> length 2) (char= (char type (1- length)) #\~)) + (let ((tilde (position #\~ type :from-end t :end (- length 2)))) + (when tilde + (parse-integer type :start (1+ tilde) :junk-allowed t)))))) + +(defun version-number (pathname) + "Return the number of the highest versioned backup of PATHNAME +or 0 if there is no versioned backup. Looks for name.type~X~, +returns highest X." + (let* ((wildpath (merge-pathnames (make-pathname :type :wild) pathname)) + (possibilities (directory wildpath))) + (loop for possibility in possibilities + for version = (extract-version-number possibility) + if (numberp version) + maximize version into max + finally (return max)))) + +(defun check-file-times (buffer filepath question answer) + "Return NIL if filepath newer than buffer and user doesn't want to overwrite" + (let ((f-w-d (file-write-date filepath)) + (f-w-t (file-write-time buffer))) + (if (and f-w-d f-w-t (> f-w-d f-w-t)) + (if (accept 'boolean + :prompt (format nil "File has changed on disk. ~a anyway?" + question)) + t + (progn (display-message "~a not ~a" filepath answer) + nil)) + t))) + (defun save-buffer (buffer) (let ((filepath (or (filepath buffer) (accept 'pathname :prompt "Save Buffer to File")))) @@ -388,16 +427,22 @@ (display-message "~A is a directory." filepath) (beep)) (t - (when (probe-file filepath) + (unless (check-file-times buffer filepath "Overwrite" "written") + (return-from save-buffer)) + (when (and (probe-file filepath) (not (file-saved-p buffer))) (let ((backup-name (pathname-name filepath)) - (backup-type (concatenate 'string (pathname-type filepath) "~"))) + (backup-type (format nil "~A~~~D~~" + (pathname-type filepath) + (1+ (version-number filepath))))) (rename-file filepath (make-pathname :name backup-name - :type backup-type)))) + :type backup-type))) + (setf (file-saved-p buffer) t)) (with-open-file (stream filepath :direction :output :if-exists :supersede) (output-to-stream stream buffer 0 (size buffer))) (setf (filepath buffer) filepath + (file-write-time buffer) (file-write-date filepath) (name buffer) (filepath-filename filepath)) - (display-message "Wrote: ~a" (filepath buffer)) + (display-message "Wrote: ~a" filepath) (setf (needs-saving buffer) nil))))) (define-command (com-save-buffer :name t :command-table buffer-table) ()

1 0

[climacs-cvs] CVS climacs
by dmurray 04 May '06

04 May '06

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv8008 Modified Files: misc-commands.lisp Log Message: Added some docstrings for commands. --- /project/climacs/cvsroot/climacs/misc-commands.lisp 2006/05/02 19:59:21 1.8 +++ /project/climacs/cvsroot/climacs/misc-commands.lisp 2006/05/04 20:30:29 1.9 @@ -36,6 +36,8 @@ (evaluate-local-options-line (current-buffer))) (define-command (com-overwrite-mode :name t :command-table editing-table) () + "Toggle overwrite mode for the current mode. +When overwrite is on, an object entered on the keyboard will replace the object after the point. When overwrite is off (the default), objects are inserted at point. In both cases point is positioned after the new object." (with-slots (overwrite-mode) (current-window) (setf overwrite-mode (not overwrite-mode)))) @@ -44,6 +46,8 @@ '((:insert))) (define-command (com-not-modified :name t :command-table buffer-table) () + "Clear the modified flag for the current buffer. +The modified flag is automatically set when the contents of the buffer are changed. This flag is consulted, for instance, when deciding whether to prompt you to save the buffer before killing it." (setf (needs-saving (buffer (current-window))) nil)) (set-key 'com-not-modified @@ -52,6 +56,8 @@ (define-command (com-set-fill-column :name t :command-table fill-table) ((column 'integer :prompt "Column Number:")) + "Set the fill column to the specified value. +You must supply a numeric argument. The fill column is the column beyond which automatic line-wrapping will occur. The default fill column is 70." (set-fill-column column)) (set-key `(com-set-fill-column ,*numeric-argument-marker*) @@ -97,6 +103,7 @@ (loop repeat count do (insert-character *current-gesture*))) (define-command (com-beginning-of-line :name t :command-table movement-table) () + "Move point to the beginning of the current line." (beginning-of-line (point (current-window)))) (set-key 'com-beginning-of-line @@ -108,6 +115,7 @@ '((#\a :control))) (define-command (com-end-of-line :name t :command-table movement-table) () + "Move point to the end of the current line." (end-of-line (point (current-window)))) (set-key 'com-end-of-line @@ -121,6 +129,8 @@ (define-command (com-delete-object :name t :command-table deletion-table) ((count 'integer :prompt "Number of Objects") (killp 'boolean :prompt "Kill?")) + "Delete the object after point. +With a numeric argument, kill that many objects after (or before, if negative) point." (let* ((point (point (current-window))) (mark (clone-mark point))) (forward-object mark count) @@ -142,6 +152,8 @@ (define-command (com-backward-delete-object :name t :command-table deletion-table) ((count 'integer :prompt "Number of Objects") (killp 'boolean :prompt "Kill?")) + "Delete the object before point. +With a numeric argument, kills that many objects before (or after, if negative) point." (let* ((point (point (current-window))) (mark (clone-mark point))) (backward-object mark count) @@ -156,6 +168,8 @@ '(#\Backspace)) (define-command (com-zap-to-object :name t :command-table deletion-table) () + "Prompt for an object and kill the objects between point and the next occurence of that object after point. +Characters can be entered in #\ format." (let* ((item (handler-case (accept 't :prompt "Zap to Object") (error () (progn (beep) (display-message "Not a valid object") @@ -167,6 +181,8 @@ (delete-range current-point (- (offset item-mark) current-offset)))) (define-command (com-zap-to-character :name t :command-table deletion-table) () + "Prompt for a character and kill the objects between point and the next occurence of that character after point. +FIXME: Accepts a string (that is, zero or more characters) terminated by a #\NEWLINE. If a zero length string signals an error. If a string of length >1, uses the first character of the string." (let* ((item-string (handler-case (accept 'string :prompt "Zap to Character") ; Figure out how to get #\d and d. (or 'string 'character)? (error () (progn (beep) (display-message "Not a valid string. ") @@ -196,6 +212,9 @@ (forward-object mark)))) (define-command (com-transpose-objects :name t :command-table editing-table) () + "Transpose the objects before and after point, advancing point. +At the end of a line transpose the previous two objects without advancing point. At the beginning of the buffer do nothing. At the beginning of any line other than the first effectively move the first object of that line to the end of the previous line. +FIXME: at the end of a single object line at the beginning of the buffer deletes that object." (transpose-objects (point (current-window)))) (set-key 'com-transpose-objects @@ -204,6 +223,8 @@ (define-command (com-backward-object :name t :command-table movement-table) ((count 'integer :prompt "Number of Objects")) + "Move point backward one object. +With a numeric argument, move point backward (or forward, if negative) that number of objects." (backward-object (point (current-window)) count)) (set-key `(com-backward-object ,*numeric-argument-marker*) @@ -216,6 +237,8 @@ (define-command (com-forward-object :name t :command-table movement-table) ((count 'integer :prompt "Number of Objects")) + "Move point forward one object. +With a numeric argument, move point forward (or backward, if negative) that number of objects." (forward-object (point (current-window)) count)) (set-key `(com-forward-object ,*numeric-argument-marker*) @@ -250,6 +273,9 @@ (forward-word mark)))) (define-command (com-transpose-words :name t :command-table editing-table) () + "Transpose the words around point, leaving point at the end of them. +With point in the whitespace between words, transpose the words before and after point. With point inside a word, transpose that word with the next one. With point before the first word of the buffer, transpose the first two words of the buffer. +FIXME: with point after the penultimate word of the buffer, or if there are <2 words in the buffer, Strange Things (TM) happen (including breaking Climacs)." (transpose-words (point (current-window)))) (set-key 'com-transpose-words @@ -279,6 +305,8 @@ (insert-object mark #\Newline))) (define-command (com-transpose-lines :name t :command-table editing-table) () + "Transpose current line and previous line, leaving point at the end of them. +If point is in the first line, transpose the first two lines. If point is in the last line of the buffer and there is no final #\Newline, add one." (transpose-lines (point (current-window)))) (set-key 'com-transpose-lines @@ -287,6 +315,8 @@ (define-command (com-previous-line :name t :command-table movement-table) ((numarg 'integer :prompt "How many lines?")) + "Move point to the previous line. +With a numeric argument, move point up (down, if negative) that many lines. Successive line movement commands seek to respect the 'goal column'." (let* ((window (current-window)) (point (point window))) (unless (or (eq (previous-command window) 'com-previous-line) @@ -306,6 +336,8 @@ (define-command (com-next-line :name t :command-table movement-table) ((numarg 'integer :prompt "How many lines?")) + "Move point to the next line. +With a numeric argument, move point down (up, if negative) that many lines. Successive line movement commands seek to respect the 'goal column'." (let* ((window (current-window)) (point (point window))) (unless (or (eq (previous-command window) 'com-previous-line) @@ -325,6 +357,8 @@ (define-command (com-open-line :name t :command-table editing-table) ((numarg 'integer :prompt "How many lines?")) + "Insert a #\Newline and leave point before it. +With a numeric argument greater than 1, insert that many #\Newlines." (open-line (point (current-window)) numarg)) (set-key `(com-open-line ,*numeric-argument-marker*) @@ -362,6 +396,8 @@ (define-command (com-kill-line :name t :command-table deletion-table) ((numarg 'integer :prompt "Kill how many lines?") (numargp 'boolean :prompt "Kill entire lines?")) + "Kill the objects on the current line after point. +When at the end of a line, kill the #\Newline. With a numeric argument of 0, kill the objects on the current line before point. With a non-zero numeric argument, kill that many lines forward (backward, if negative) from point. Successive kills append to the kill ring." (let* ((pane (current-window)) (point (point pane)) (concatenate-p (eq (previous-command pane) 'com-kill-line))) @@ -373,6 +409,8 @@ (define-command (com-forward-word :name t :command-table movement-table) ((count 'integer :prompt "Number of words")) + "Move point to the next word end. +With a numeric argument, move point forward (backward, if negative) that many words." (if (plusp count) (forward-word (point (current-window)) count) (backward-word (point (current-window)) (- count)))) @@ -387,6 +425,8 @@ (define-command (com-backward-word :name t :command-table movement-table) ((count 'integer :prompt "Number of words")) + "Move point to the previous word beginning. +With a numeric argument, move point backward (forward, if negative) that many words." (backward-word (point (current-window)) count)) (set-key `(com-backward-word ,*numeric-argument-marker*) @@ -399,6 +439,8 @@ (define-command (com-delete-word :name t :command-table deletion-table) ((count 'integer :prompt "Number of words")) + "Delete from point until the next word end. +With a positive numeric argument, delete that many words forward." (delete-word (point (current-window)) count)) (defun kill-word (mark &optional (count 1) (concatenate-p nil)) @@ -423,6 +465,8 @@ (define-command (com-kill-word :name t :command-table deletion-table) ((count 'integer :prompt "Number of words")) + "Kill from point until the next word end. +With a numeric argument, kill forward (backward, if negative) that many words. Successive kills append to the kill ring." (let* ((pane (current-window)) (point (point pane)) (concatenate-p (eq (previous-command pane) 'com-kill-word))) @@ -434,6 +478,8 @@ (define-command (com-backward-kill-word :name t :command-table deletion-table) ((count 'integer :prompt "Number of words")) + "Kill from point until the previous word beginning. +With a numeric argument, kill backward (forward, if negative) that many words. Successive kills append to the kill ring." (let* ((pane (current-window)) (point (point pane)) (concatenate-p (eq (previous-command pane) 'com-backward-kill-word))) @@ -445,6 +491,8 @@ (define-command (com-mark-word :name t :command-table marking-table) ((count 'integer :prompt "Number of words")) + "Place mark at the next word end. +With a positive numeric argument, place mark at the end of that many words forward. With a negative numeric argument, place mark at the beginning of that many words backward. Successive invocations extend the selection." (let* ((pane (current-window)) (point (point pane)) (mark (mark pane))) @@ -460,21 +508,28 @@ (define-command (com-backward-delete-word :name t :command-table deletion-table) ((count 'integer :prompt "Number of words")) + "Delete from point until the previous word beginning. +With a positive numeric argument, delete that many words backward." (backward-delete-word (point (current-window)) count)) (define-command (com-upcase-region :name t :command-table case-table) () + "Convert the region to upper case." (let ((cw (current-window))) (upcase-region (mark cw) (point cw)))) (define-command (com-downcase-region :name t :command-table case-table) () + "Convert the region to lower case." (let ((cw (current-window))) (downcase-region (mark cw) (point cw)))) (define-command (com-capitalize-region :name t :command-table case-table) () + "Capitalize each word in the region." (let ((cw (current-window))) (capitalize-region (mark cw) (point cw)))) (define-command (com-upcase-word :name t :command-table case-table) () + "Convert the characters from point until the next word end to upper case. +Leave point at the word end." (upcase-word (point (current-window)))) (set-key 'com-upcase-word @@ -482,6 +537,8 @@ '((#\u :meta))) (define-command (com-downcase-word :name t :command-table case-table) () + "Convert the characters from point until the next word end to lower case. +Leave point at the word end." (downcase-word (point (current-window)))) (set-key 'com-downcase-word @@ -489,6 +546,8 @@ '((#\l :meta))) (define-command (com-capitalize-word :name t :command-table case-table) () + "Capitalize the next word. +If point is in a word, convert the next character to upper case and the remaining letters in the word to lower case. If point is before the start of a word, convert the first character of that word to upper case and the rest of the letters to lower case. Leave point at the word end." (capitalize-word (point (current-window)))) (set-key 'com-capitalize-word @@ -496,11 +555,15 @@ '((#\c :meta))) (define-command (com-tabify-region :name t :command-table editing-table) () + "Replace runs of spaces with tabs in region where possible. +Uses TAB-SPACE-COUNT of the STREAM-DEFAULT-VIEW of the pane." (let ((pane (current-window))) (tabify-region (mark pane) (point pane) (tab-space-count (stream-default-view pane))))) (define-command (com-untabify-region :name t :command-table editing-table) () + "Replace tabs with equivalent runs of spaces in the region. +Uses TAB-SPACE-COUNT of the STREAM-DEFAULT-VIEW of the pane." (let ((pane (current-window))) (untabify-region (mark pane) (point pane) (tab-space-count (stream-default-view pane))))) @@ -568,6 +631,8 @@ (indent-region pane point mark))) (define-command (com-delete-indentation :name t :command-table indent-table) () + "Join current line to previous non-blank line. +Leaves a single space between the last non-whitespace object of the previous line and the first non-whitespace object of the current line, and point after that space. If there is no previous non-blank line, deletes all whitespace at the beginning of the buffer at leaves point there." (delete-indentation (point (current-window)))) (set-key 'com-delete-indentation @@ -603,6 +668,7 @@ '((#\q :meta))) (define-command (com-beginning-of-buffer :name t :command-table movement-table) () + "Move point to the beginning of the buffer." (beginning-of-buffer (point (current-window)))) (set-key 'com-beginning-of-buffer @@ -638,6 +704,7 @@ '((:prior))) (define-command (com-end-of-buffer :name t :command-table movement-table) () + "Move point to the end of the buffer." (end-of-buffer (point (current-window)))) (set-key 'com-end-of-buffer @@ -649,6 +716,7 @@ '((:end :control))) (define-command (com-mark-whole-buffer :name t :command-table marking-table) () + "Place point at the beginning and mark at the end of the buffer." (beginning-of-buffer (point (current-window))) (end-of-buffer (mark (current-window)))) @@ -663,6 +731,8 @@ do (forward-object mark))) (define-command (com-back-to-indentation :name t :command-table movement-table) () + "Move point to the first non-whitespace object on the current line. +If there is no non-whitespace object, leaves point at the end of the line." (back-to-indentation (point (current-window)))) (set-key 'com-back-to-indentation @@ -683,6 +753,8 @@ (define-command (com-delete-horizontal-space :name t :command-table deletion-table) ((backward-only-p 'boolean :prompt "Delete backwards only?")) + "Delete whitespace around point. +With a numeric argument, only delete whitespace before point." (delete-horizontal-space (point (current-window)) backward-only-p)) (set-key `(com-delete-horizontal-space ,*numeric-argument-p*) @@ -705,6 +777,9 @@ (define-command (com-just-one-space :name t :command-table deletion-table) ((count 'integer :prompt "Number of spaces")) + "Delete whitespace around point, leaving a single space. +With a positive numeric argument, leave that many spaces. +FIXME: should distinguish between types of whitespace." (just-one-space (point (current-window)) count)) (set-key `(com-just-one-space ,*numeric-argument-marker*) @@ -715,6 +790,7 @@ (setf (offset mark) pos)) (define-command (com-goto-position :name t :command-table movement-table) () + "Prompts for an integer, and sets the offset of point to that integer." (goto-position (point (current-window)) (handler-case (accept 'integer :prompt "Goto Position") @@ -735,6 +811,8 @@ (setf (offset mark) (offset m)))) (define-command (com-goto-line :name t :command-table movement-table) () + "Prompts for a line number, and sets point to the beginning of that line. +The first line of the buffer is 1. Giving a number <1 leaves point at the beginning of the buffer. Giving a line number larger than the number of the last line in the buffer leaves point at the beginning of the last line of the buffer." (goto-line (point (current-window)) (handler-case (accept 'integer :prompt "Goto Line") (error () (progn (beep) @@ -749,6 +827,7 @@ (ccl:run-program "/usr/bin/open" `(,url) :wait nil))) (define-command (com-set-mark :name t :command-table marking-table) () + "Set mark to the current position of point." (let ((pane (current-window))) (setf (mark pane) (clone-mark (point pane))))) @@ -757,6 +836,7 @@ '((#\Space :control))) (define-command (com-exchange-point-and-mark :name t :command-table marking-table) () + "Exchange the positions of point and mark." (let ((pane (current-window))) (psetf (offset (mark pane)) (offset (point pane)) (offset (point pane)) (offset (mark pane))))) @@ -784,6 +864,8 @@ (display-message "No such syntax: ~A." syntax))))) (define-command (com-set-syntax :name t :command-table buffer-table) () + "Prompts for a syntax to set for the current buffer. +Setting a syntax will cause the buffer to be reparsed using the new syntax." (let* ((pane (current-window)) (buffer (buffer pane))) (handler-case (set-syntax buffer (accept 'syntax :prompt "Set Syntax")) @@ -796,6 +878,7 @@ ;; Copies an element from a kill-ring to a buffer at the given offset (define-command (com-yank :name t :command-table editing-table) () + "Insert the objects most recently added to the kill ring at point." (insert-sequence (point (current-window)) (kill-ring-yank *kill-ring*))) (set-key 'com-yank @@ -804,6 +887,8 @@ ;; Destructively cut a given buffer region into the kill-ring (define-command (com-kill-region :name t :command-table editing-table) () + "Kill the objects between point and mark. +That is, push them onto the kill ring, and delete them from the buffer." (let ((pane (current-window))) (kill-ring-standard-push [325 lines skipped]

1 0

[climacs-cvs] CVS climacs
by dmurray 04 May '06

04 May '06

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv30103 Modified Files: gui.lisp Log Message: Added some docstrings to commands. --- /project/climacs/cvsroot/climacs/gui.lisp 2006/05/02 18:02:15 1.211 +++ /project/climacs/cvsroot/climacs/gui.lisp 2006/05/04 19:03:46 1.212 @@ -314,6 +314,8 @@ (find-command-table 'global-climacs-table))) (define-command (com-full-redisplay :name t :command-table base-table) () + "Redisplay the contents of the current window. +FIXME: does this really have that effect?" (full-redisplay (current-window))) (set-key 'com-full-redisplay @@ -332,6 +334,8 @@ (beep)))))) (define-command (com-load-file :name t :command-table base-table) () + "Prompt for a filename and CL:LOAD that file. +Signals and error if the file does not exist." (let ((filepath (accept 'pathname :prompt "Load File"))) (load-file filepath))) @@ -429,6 +433,8 @@ ;; (note-pane-syntax-changed pane (syntax buffer))) (define-command (com-switch-to-buffer :name t :command-table pane-table) () + "Prompt for a buffer name and switch to that buffer. +If the a buffer with that name does not exist, create it. Uses the name of the next buffer (if any) as a default." (let* ((default (second (buffers *application-frame*))) (buffer (if default (accept 'buffer @@ -469,6 +475,8 @@ (kill-buffer (buffer (current-window)))) (define-command (com-kill-buffer :name t :command-table pane-table) () + "Prompt for a buffer name and kill that buffer. +If the buffer needs saving, will prompt you to do so before killing it. Uses the current buffer as a default." (let ((buffer (accept 'buffer :prompt "Kill buffer" :default (buffer (current-window))

1 0

[climacs-cvs] CVS climacs
by dmurray 04 May '06

04 May '06

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv28462 Modified Files: file-commands.lisp Log Message: Added some docstrings to commands. --- /project/climacs/cvsroot/climacs/file-commands.lisp 2006/04/23 19:37:58 1.9 +++ /project/climacs/cvsroot/climacs/file-commands.lisp 2006/05/04 18:53:52 1.10 @@ -251,6 +251,8 @@ (user-homedir-pathname))))) (define-command (com-find-file :name t :command-table buffer-table) () + "Prompt for a filename then edit that file. +If a buffer is already visiting that file, switch to that buffer. Does not create a file if the filename given does not name an existing file." (let* ((filepath (accept 'pathname :prompt "Find File" :default (directory-of-buffer (buffer (current-window))) :default-type 'pathname @@ -298,6 +300,8 @@ nil))))))) (define-command (com-find-file-read-only :name t :command-table buffer-table) () + "Prompt for a filename then open that file readonly. +If a buffer is already visiting that file, switch to that buffer. If the filename given does not name an existing file, signal an error." (let ((filepath (accept 'pathname :Prompt "Find file read only" :default (directory-of-buffer (buffer (current-window))) :default-type 'pathname @@ -309,6 +313,8 @@ '((#\x :control) (#\r :control))) (define-command (com-read-only :name t :command-table buffer-table) () + "Toggle the readonly status of the current buffer. +When a buffer is readonly, attempts to change the contents of the buffer signal an error." (let ((buffer (buffer (current-window)))) (setf (read-only-p buffer) (not (read-only-p buffer))))) @@ -322,6 +328,8 @@ (needs-saving buffer) t)) (define-command (com-set-visited-file-name :name t :command-table buffer-table) () + "Prompt for a new filename for the current buffer. +The next time the buffer is saved it will be saved to a file with that filename." (let ((filename (accept 'pathname :prompt "New file name" :default (directory-of-buffer (buffer (current-window))) :default-type 'pathname @@ -329,6 +337,8 @@ (set-visited-file-name filename (buffer (current-window))))) (define-command (com-insert-file :name t :command-table buffer-table) () + "Prompt for a filename and insert its contents at point. +Leaves mark after the inserted contents." (let ((filename (accept 'pathname :prompt "Insert File" :default (directory-of-buffer (buffer (current-window))) :default-type 'pathname @@ -349,6 +359,8 @@ '((#\x :control) (#\i :control))) (define-command (com-revert-buffer :name t :command-table buffer-table) () + "Replace the contents of the current buffer with the visited file. +Signals an error if the file does not exist." (let* ((pane (current-window)) (buffer (buffer pane)) (filepath (filepath buffer)) @@ -389,6 +401,8 @@ (setf (needs-saving buffer) nil))))) (define-command (com-save-buffer :name t :command-table buffer-table) () + "Write the contents of the buffer to a file. +If there is filename associated with the buffer, write to that file, replacing its contents. If not, prompt for a filename." (let ((buffer (buffer (current-window)))) (if (or (null (filepath buffer)) (needs-saving buffer)) @@ -418,6 +432,8 @@ (call-next-method))) (define-command (com-write-buffer :name t :command-table buffer-table) () + "Prompt for a filename and write the current buffer to it. +Changes the file visted by the buffer to the given file." (let ((filepath (accept 'pathname :prompt "Write Buffer to File" :default (directory-of-buffer (buffer (current-window))) :default-type 'pathname

1 0

[climacs-cvs] CVS esa
by dmurray 04 May '06

04 May '06

Update of /project/climacs/cvsroot/esa In directory clnet:/tmp/cvs-serv26407 Modified Files: esa.lisp Log Message: Added some docstrings for commands. --- /project/climacs/cvsroot/esa/esa.lisp 2006/05/04 08:08:36 1.11 +++ /project/climacs/cvsroot/esa/esa.lisp 2006/05/04 18:32:38 1.12 @@ -471,6 +471,8 @@ (define-command-table global-esa-table) (define-command (com-quit :name t :command-table global-esa-table) () + "Exit Climacs. +First ask if modified buffers should be saved. If you decide not to save a modified buffer, you will be asked to confirm your decision to exit." (frame-exit *application-frame*)) (set-key 'com-quit 'global-esa-table '((#\x :control) (#\c :control))) @@ -479,6 +481,7 @@ :name t :command-table global-esa-table) () + "Prompt for a command name and arguments, then run it." (let ((item (handler-case (accept `(command :command-table ,(find-applicable-command-table *application-frame*)) @@ -720,6 +723,7 @@ (define-command-table help-table) (define-command (com-describe-key-briefly :name t :command-table help-table) () + "Prompt for a key and show the command it invokes." (display-message "Describe key briefly:") (redisplay-frame-panes *application-frame*) (describe-key-briefly (car (windows *application-frame*)))) @@ -727,6 +731,7 @@ (set-key 'com-describe-key-briefly 'help-table '((#\h :control) (#\c))) (define-command (com-where-is :name t :command-table help-table) () + "Prompt for a command name and show the key that invokes it." (let* ((command-table (command-table (car (windows *application-frame*)))) (command (handler-case @@ -749,6 +754,8 @@ (define-command (com-describe-bindings :name t :command-table help-table) ((sort-by-keystrokes 'boolean :prompt "Sort by keystrokes?")) + "Pop up a help window showing which keys invoke which commands. +Without a numeric prefix, sorts the list by command name. With a numeric prefix, sorts by key." (let* ((window (car (windows *application-frame*))) (stream (open-window-stream :label (format nil "Help: Describe Bindings") @@ -774,6 +781,8 @@ :name t :command-table keyboard-macro-table) () + "Start recording keys to define a keyboard macro. +Use C-x ) to finish recording the macro, and C-x e to run it." (setf (recordingp *application-frame*) t) (setf (recorded-keys *application-frame*) '())) @@ -783,6 +792,8 @@ :name t :command-table keyboard-macro-table) () + "Finish recording keys that define a keyboard macro. +Use C-x ( to start recording a macro, and C-x e to run it." (setf (recordingp *application-frame*) nil) (setf (recorded-keys *application-frame*) ;; this won't work if the command was invoked in any old way @@ -794,6 +805,8 @@ :name t :command-table keyboard-macro-table) () + "Run the last keyboard macro that was defined. +Use C-x ( to start and C-x ) to finish recording a keyboard macro." (setf (remaining-keys *application-frame*) (recorded-keys *application-frame*)) (setf (executingp *application-frame*) t))

1 0

[climacs-cvs] CVS esa
by crhodes 04 May '06

04 May '06

Update of /project/climacs/cvsroot/esa In directory clnet:/tmp/cvs-serv9089 Modified Files: esa.lisp Log Message: Fix esa describe-bindings. --- /project/climacs/cvsroot/esa/esa.lisp 2006/05/04 08:06:29 1.10 +++ /project/climacs/cvsroot/esa/esa.lisp 2006/05/04 08:08:36 1.11 @@ -610,7 +610,10 @@ results)) (defun sort-by-name (list) - (sort list #'string< :key (lambda (item) (symbol-name (second item))))) + (sort list #'string< :key (lambda (item) + (symbol-name (if (listp (cdr item)) + (cadr item) + (cdr item)))))) (defun sort-by-keystrokes (list) (sort list (lambda (a b) @@ -628,10 +631,11 @@ (defun describe-bindings (stream command-table &optional (sort-function #'sort-by-name)) (formatting-table (stream) - (loop for (keys command) + (loop for (keys . command) in (funcall sort-function (find-all-keystrokes-and-commands-with-inheritance command-table)) + when (consp command) do (setq command (car command)) do (formatting-row (stream) (formatting-cell (stream :align-x :right) (with-text-style (stream '(:sans-serif nil nil))

1 0

[climacs-cvs] CVS esa
by crhodes 04 May '06

04 May '06

Update of /project/climacs/cvsroot/esa In directory clnet:/tmp/cvs-serv8949 Modified Files: esa.lisp Log Message: Handle parse errors on the minibuffer. Not completely ideal, but probably mostly works right now. Will work better with the new command processor. --- /project/climacs/cvsroot/esa/esa.lisp 2006/05/02 18:01:49 1.9 +++ /project/climacs/cvsroot/esa/esa.lisp 2006/05/04 08:06:29 1.10 @@ -59,6 +59,17 @@ (declare (ignore type args)) (window-clear pane)) +(defmethod stream-accept :around ((pane minibuffer-pane) type &rest args) + (declare (ignore args)) + ;; FIXME: this isn't the friendliest way of indicating a parse + ;; error: there's no feedback, unlike emacs' quite nice "[no + ;; match]". + (loop + (handler-case + (return (call-next-method)) + (parse-error () + nil)))) + (defun display-minibuffer (frame pane) (declare (ignore frame)) (when (message pane)

1 0

[climacs-cvs] CVS climacs
by thenriksen 03 May '06

03 May '06

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv12922 Modified Files: lisp-syntax.lisp Log Message: Added `incomplete-character-lexeme' class and removed duplicate definition of `form-operator' (oops). --- /project/climacs/cvsroot/climacs/lisp-syntax.lisp 2006/05/02 17:47:19 1.62 +++ /project/climacs/cvsroot/climacs/lisp-syntax.lisp 2006/05/03 16:14:27 1.63 @@ -210,6 +210,7 @@ (defclass comma-at-lexeme (lisp-lexeme) ()) (defclass comma-dot-lexeme (lisp-lexeme) ()) (defclass form-lexeme (form lisp-lexeme) ()) +(defclass incomplete-character-lexeme (form-lexeme incomplete-form-mixin) ()) (defclass character-lexeme (form-lexeme) ()) (defclass function-lexeme (lisp-lexeme) ()) (defclass line-comment-start-lexeme (lisp-lexeme) ()) @@ -301,7 +302,7 @@ (make-instance 'error-lexeme)) (#\\ (fo) (cond ((end-of-buffer-p scan) - (make-instance 'incomplete-lexeme)) + (make-instance 'incomplete-character-lexeme)) ((not (constituentp (object-after scan))) (fo) (make-instance 'character-lexeme)) (t (loop until (end-of-buffer-p scan) @@ -1835,17 +1836,6 @@ (defun in-comment-p (mark syntax) (in-type-p mark syntax 'comment)) -(defgeneric form-operator (form syntax) - (:documentation "Return the operator of `form' as a -symbol. Returns nil if none can be found.") - (:method (form syntax) nil)) - -(defmethod form-operator ((form list-form) syntax) - (let* ((operator-token (first-noncomment (rest (children form)))) - (operator-symbol (when operator-token - (token-to-object syntax operator-token)))) - operator-symbol)) - ;;; shamelessly replacing SWANK code ;; We first work through the string removing the characters and noting ;; which ones are escaped. We then replace each character with the

1 0

[climacs-cvs] CVS climacs
by thenriksen 02 May '06

02 May '06

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv14735 Modified Files: syntax.lisp misc-commands.lisp Log Message: Make Climacs not signal an error when an invalid syntax is input. --- /project/climacs/cvsroot/climacs/syntax.lisp 2006/04/23 12:11:26 1.62 +++ /project/climacs/cvsroot/climacs/syntax.lisp 2006/05/02 19:59:21 1.63 @@ -258,7 +258,10 @@ :value-key #'syntax-description-class-name)) :partial-completers '(#\Space) :allow-any-input t) - (declare (ignore success string)) + (declare (ignore success)) + (if (find string *syntaxes* :key #'first :test #'string=) + (values object type) + (input-not-of-required-type string type)) object)) (defun syntax-from-name (syntax) --- /project/climacs/cvsroot/climacs/misc-commands.lisp 2006/04/30 15:12:05 1.7 +++ /project/climacs/cvsroot/climacs/misc-commands.lisp 2006/05/02 19:59:21 1.8 @@ -786,7 +786,10 @@ (define-command (com-set-syntax :name t :command-table buffer-table) () (let* ((pane (current-window)) (buffer (buffer pane))) - (set-syntax buffer (accept 'syntax :prompt "Set Syntax")))) + (handler-case (set-syntax buffer (accept 'syntax :prompt "Set Syntax")) + (input-not-of-required-type + (message) + (display-message "Invalid syntax: ~A." message))))) ;;;;;;;;;;;;;;;;;;;; ;; Kill ring commands

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

climacs-cvs May 2006