From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Michael Sperber Newsgroups: gmane.emacs.devel Subject: Re: read syntax for window configs Date: Thu, 18 Mar 2010 17:07:00 +0100 Message-ID: References: <86bpf7q3fc.wl%lluis@ginnungagap.pc.ac.upc.edu> <87wrxvyijr.fsf@stupidchicken.com> <4B8C42E2.3080308@siege-engine.com> <7697A57B1AD9104F993CDF6A5B69430C09227D1F24@CORPMAIL08.corp.capgemini.com> <878wabxg0x.fsf@uwakimon.sk.tsukuba.ac.jp> <87mxyrhxq8.fsf@lola.goethe.zz> <7697A57B1AD9104F993CDF6A5B69430C09227D1FCE@CORPMAIL08.corp.capgemini.com> <7697A57B1AD9104F993CDF6A5B69430C09227D1FF5@CORPMAIL08.corp.capgemini.com> <87wrxu79r6.fsf@mail.jurta.org> <87wrxuw0pd.fsf@uwakimon.sk.tsukuba.ac.jp> <86716EEF25B64190B631AD85710E965D@us.oracle.com> NNTP-Posting-Host: lo.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: dough.gmane.org 1268936067 16471 80.91.229.12 (18 Mar 2010 18:14:27 GMT) X-Complaints-To: usenet@dough.gmane.org NNTP-Posting-Date: Thu, 18 Mar 2010 18:14:27 +0000 (UTC) Cc: "'Berndl, Klaus'" , 'Lennart Borgman' , mike@xemacs.org, emacs-devel@gnu.org, 'Juri Linkov' , "'Stephen J. Turnbull'" To: "Drew Adams" Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Thu Mar 18 19:14:21 2010 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([199.232.76.165]) by lo.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1NsKEG-0000OM-Nr for ged-emacs-devel@m.gmane.org; Thu, 18 Mar 2010 19:14:16 +0100 Original-Received: from localhost ([127.0.0.1]:55465 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1NsKEC-0005P8-5y for ged-emacs-devel@m.gmane.org; Thu, 18 Mar 2010 14:13:52 -0400 Original-Received: from mailman by lists.gnu.org with tmda-scanned (Exim 4.43) id 1NsIFZ-0005E5-JW for emacs-devel@gnu.org; Thu, 18 Mar 2010 12:07:09 -0400 Original-Received: from [140.186.70.92] (port=45720 helo=eggs.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1NsIFX-0005CB-5j for emacs-devel@gnu.org; Thu, 18 Mar 2010 12:07:08 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.69) (envelope-from ) id 1NsIFV-0003Ao-Ae for emacs-devel@gnu.org; Thu, 18 Mar 2010 12:07:06 -0400 Original-Received: from h615406.serverkompetenz.net ([81.169.143.132]:61453) by eggs.gnu.org with esmtp (Exim 4.69) (envelope-from ) id 1NsIFU-0003AH-SA for emacs-devel@gnu.org; Thu, 18 Mar 2010 12:07:05 -0400 Original-Received: from h615406.serverkompetenz.net (localhost [127.0.0.1]) by h615406.serverkompetenz.net (Postfix) with ESMTP id 4B9C617063; Thu, 18 Mar 2010 16:06:10 +0000 (UTC) Original-Received: from eta.local (p5B205238.dip.t-dialin.net [91.32.82.56]) (using TLSv1 with cipher ADH-AES256-SHA (256/256 bits)) (No client certificate requested) by h615406.serverkompetenz.net (Postfix) with ESMTPSA id B655C17062; Thu, 18 Mar 2010 16:06:09 +0000 (UTC) Original-Received: by eta.local (Postfix, from userid 2246) id 8B4FA6F3B9A; Thu, 18 Mar 2010 17:07:00 +0100 (CET) In-Reply-To: <86716EEF25B64190B631AD85710E965D@us.oracle.com> (Drew Adams's message of "Fri, 5 Mar 2010 09:07:38 -0800") User-Agent: Gnus/5.110011 (No Gnus v0.11) XEmacs/21.5-b29 (darwin) X-Virus-Scanned: ClamAV using ClamSMTP X-detected-operating-system: by eggs.gnu.org: Genre and OS details not recognized. X-Mailman-Approved-At: Thu, 18 Mar 2010 14:13:18 -0400 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.5 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:122192 Archived-At: --=-=-= Content-Type: text/plain; charset=iso-8859-1 Content-Transfer-Encoding: quoted-printable "Drew Adams" writes: >> > > Since XEmacs have lots of other object types, maybe=20 >> > > XEmacs already has a read syntax for window configurations >>=20 >> Window configurations in XEmacs don't have read syntax, but they're >> pretty close, and thus it wouldn't be hard to do. > > Read syntax for window (and frame) configs would be very welcome. I've attached code that works for XEmacs. Is this along the line of what you'd like? --=20 Cheers =3D8-} Mike Friede, V=F6lkerverst=E4ndigung und =FCberhaupt blabla --=-=-= Content-Disposition: inline (defun window-configuration->sexp (config) "Convert a window configuration to a readable S-expression." `(window-configuration (frame . ,(position (window-configuration-frame config) (frame-list))) ; lame, but the best we can do (frame-top . ,(window-configuration-frame-top config)) (frame-left . ,(window-configuration-frame-left config)) (frame-pixel-width . ,(window-configuration-frame-pixel-width config)) (frame-pixel-height . ,(window-configuration-frame-pixel-height config)) (current-buffer . ,(buffer-name (window-configuration-current-buffer config))) (minibuffer-pixel-height . ,(window-configuration-minibuffer-pixel-height config)) (min-width . ,(window-configuration-min-width config)) (min-height . ,(window-configuration-min-height config)) (saved-root-window . ,(saved-window->sexp (window-configuration-saved-root-window config))))) (defun saved-window->sexp (saved) "Convert a saved-window structure to a readable S-expression." `(saved-window (currentp . ,(saved-window-currentp saved)) (minibufferp . ,(saved-window-minibuffer-scrollp saved)) (minibuffer-scrollp . ,(saved-window-minibuffer-scrollp saved)) (buffer . ,(buffer-name (saved-window-buffer saved))) (mark-marker . ,(maybe-marker-position (saved-window-mark-marker saved))) (start-marker . ,(maybe-marker-position (saved-window-start-marker saved))) (point-marker . ,(maybe-marker-position (saved-window-point-marker saved))) (pixel-left . ,(saved-window-pixel-left saved)) (pixel-top . ,(saved-window-pixel-top saved)) (pixel-right . ,(saved-window-pixel-right saved)) (pixel-bottom . ,(saved-window-pixel-bottom saved)) (hscroll . ,(saved-window-hscroll saved)) (modeline-hscroll . ,(saved-window-modeline-hscroll saved)) (dedicatedp . ,(saved-window-dedicatedp saved)) (first-hchild . ,(maybe-saved-window->sexp (saved-window-first-hchild saved))) (first-vchild . ,(maybe-saved-window->sexp (saved-window-first-vchild saved))) (next-child . ,(maybe-saved-window->sexp (saved-window-next-child saved))))) (defun maybe-saved-window->sexp (saved) "Like `saved-window->sexp', but also accepts nil." (and saved (saved-window->sexp saved))) (defun maybe-marker-position (marker) "Extract position from marker, or return nil for nil marker." (and marker (marker-position marker))) (defun sexp->window-configuration (sexp) "Convert return value of `window-configuration->sexp' back into window config." (make-window-configuration :frame (let ((pos (sexp-tag->value sexp 'frame)) (frames (frame-list))) (if (< pos (length frames)) (nth pos frames) (car frames))) :frame-top (sexp-tag->value sexp 'frame-top) :frame-left (sexp-tag->value sexp 'frame-left) :frame-pixel-width (sexp-tag->value sexp 'frame-pixel-width) :frame-pixel-height (sexp-tag->value sexp 'frame-pixel-height) :current-buffer (get-buffer-create (sexp-tag->value sexp 'current-buffer)) :min-width (sexp-tag->value sexp 'min-width) :min-height (sexp-tag->value sexp 'min-height) :minibuffer-pixel-height (sexp-tag->value sexp 'minibuffer-pixel-height) :saved-root-window (sexp->saved-window (sexp-tag->value sexp 'saved-root-window)))) (defun sexp->saved-window (sexp) "Convert return value of `saved-window->sexp' back into saved window." (let ((buf (get-buffer-create (sexp-tag->value sexp 'buffer)))) (make-saved-window :window nil ; sorry :currentp (sexp-tag->value sexp 'currentp) :minibufferp (sexp-tag->value sexp 'minibufferp) :minibuffer-scrollp (sexp-tag->value sexp 'minibuffer-scrollp) :buffer buf :mark-marker (maybe-marker-position->marker buf (sexp-tag->value sexp 'mark-marker)) :start-marker (maybe-marker-position->marker buf (sexp-tag->value sexp 'start-marker)) :point-marker (maybe-marker-position->marker buf (sexp-tag->value sexp 'point-marker)) :pixel-left (sexp-tag->value sexp 'pixel-left) :pixel-top (sexp-tag->value sexp 'pixel-top) :pixel-right (sexp-tag->value sexp 'pixel-right) :pixel-bottom (sexp-tag->value sexp 'pixel-bottom) :hscroll (sexp-tag->value sexp 'hscroll) :modeline-hscroll (sexp-tag->value sexp 'modeline-hscroll) :dedicatedp (sexp-tag->value sexp 'dedicatedp) :first-hchild (maybe-sexp->saved-window (sexp-tag->value sexp 'first-hchild)) :first-vchild (maybe-sexp->saved-window (sexp-tag->value sexp 'first-vchild)) :next-child (maybe-sexp->saved-window (sexp-tag->value sexp 'next-child))))) (defun maybe-sexp->saved-window (sexp) "Like `sexp->saved-window', but accepts nil." (and sexp (sexp->saved-window sexp))) (defun sexp-tag->value (sexp tag) "Extract value for tag in S-expression sexp. This works for the values returned by `window-configuration->sexp' and `saved-window->sexp'. Returns nil if the tag is not there." (cdr (assq tag (cdr sexp)))) (defun maybe-marker-position->marker (buffer pos) "Turn nil or a marker position into a marker." (let ((marker (make-marker))) (set-marker marker pos buffer) marker)) --=-=-=--