Now on revision 113649. ------------------------------------------------------------ revno: 113649 committer: Xue Fuqiao branch nick: trunk timestamp: Fri 2013-08-02 14:59:25 +0800 message: * etc/tutorials/TUTORIAL.translators (Maintainer): Update the maintainer. * lisp/mh-e/mh-e.el: Add a FIXME. diff: === modified file 'etc/ChangeLog' --- etc/ChangeLog 2013-08-02 03:44:59 +0000 +++ etc/ChangeLog 2013-08-02 06:59:25 +0000 @@ -1,3 +1,7 @@ +2013-08-02 Xue Fuqiao + + * tutorials/TUTORIAL.translators (Maintainer): Update the maintainer. + 2013-08-02 Juanma Barranquero * tutorials/TUTORIAL.es: Fix typos (bug#15000). === modified file 'etc/tutorials/TUTORIAL.translators' --- etc/tutorials/TUTORIAL.translators 2012-01-21 14:58:38 +0000 +++ etc/tutorials/TUTORIAL.translators 2013-08-02 06:59:25 +0000 @@ -7,7 +7,7 @@ * TUTORIAL.cn: Author: Sun Yijiang -Maintainer: Sun Yijiang +Maintainer: Xue Fuqiao * TUTORIAL.cs: Author: Milan Zamazal === modified file 'lisp/mh-e/mh-e.el' --- lisp/mh-e/mh-e.el 2013-05-09 01:40:20 +0000 +++ lisp/mh-e/mh-e.el 2013-08-02 06:59:25 +0000 @@ -1019,6 +1019,7 @@ (when delete-other-windows-flag (delete-other-windows))) +;; FIXME: Maybe out of date? --xfq (if (boundp 'customize-package-emacs-version-alist) (add-to-list 'customize-package-emacs-version-alist '(MH-E ("6.0" . "22.1") ("6.1" . "22.1") ("7.0" . "22.1") ------------------------------------------------------------ revno: 113648 committer: Juanma Barranquero branch nick: trunk timestamp: Fri 2013-08-02 06:33:58 +0200 message: lisp/desktop.el: Move code related to saving frames to frameset.el. Require frameset. (desktop-restore-frames): Doc fix. (desktop-restore-reuses-frames): Rename from desktop-restoring-reuses-frames. (desktop-saved-frameset): Rename from desktop-saved-frame-states. (desktop-clear): Clear frames too. (desktop-filter-parameters-alist): Set from frameset-filter-alist. (desktop--filter-tty*, desktop-save, desktop-read): Use frameset functions. (desktop-before-saving-frames-functions, desktop--filter-*-color) (desktop--filter-minibuffer, desktop--filter-restore-desktop-parm) (desktop--filter-save-desktop-parm, desktop--filter-iconified-position) (desktop-restore-in-original-display-p, desktop--filter-frame-parms) (desktop--process-minibuffer-frames, desktop-save-frames) (desktop--reuse-list, desktop--compute-pos, desktop--move-onscreen) (desktop--find-frame, desktop--select-frame, desktop--make-frame) (desktop--sort-states, desktop-restoring-frames-p) (desktop-restore-frames): Remove. Most code moved to frameset.el. (desktop-restoring-frameset-p, desktop-restore-frameset) (desktop--check-dont-save, desktop-save-frameset): New functions. (desktop--app-id): New constant. (desktop-first-buffer, desktop-buffer-ok-count) (desktop-buffer-fail-count): Move before first use. lisp/frameset.el: New file. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-08-01 23:18:37 +0000 +++ lisp/ChangeLog 2013-08-02 04:33:58 +0000 @@ -1,3 +1,31 @@ +2013-08-02 Juanma Barranquero + + Move code related to saving frames to frameset.el. + * desktop.el: Require frameset. + (desktop-restore-frames): Doc fix. + (desktop-restore-reuses-frames): Rename from + desktop-restoring-reuses-frames. + (desktop-saved-frameset): Rename from desktop-saved-frame-states. + (desktop-clear): Clear frames too. + (desktop-filter-parameters-alist): Set from frameset-filter-alist. + (desktop--filter-tty*, desktop-save, desktop-read): + Use frameset functions. + (desktop-before-saving-frames-functions, desktop--filter-*-color) + (desktop--filter-minibuffer, desktop--filter-restore-desktop-parm) + (desktop--filter-save-desktop-parm, desktop--filter-iconified-position) + (desktop-restore-in-original-display-p, desktop--filter-frame-parms) + (desktop--process-minibuffer-frames, desktop-save-frames) + (desktop--reuse-list, desktop--compute-pos, desktop--move-onscreen) + (desktop--find-frame, desktop--select-frame, desktop--make-frame) + (desktop--sort-states, desktop-restoring-frames-p) + (desktop-restore-frames): Remove. Most code moved to frameset.el. + (desktop-restoring-frameset-p, desktop-restore-frameset) + (desktop--check-dont-save, desktop-save-frameset): New functions. + (desktop--app-id): New constant. + (desktop-first-buffer, desktop-buffer-ok-count) + (desktop-buffer-fail-count): Move before first use. + * frameset.el: New file. + 2013-08-01 Stefan Monnier * files.el: Use lexical-binding. === modified file 'lisp/desktop.el' --- lisp/desktop.el 2013-07-28 22:43:01 +0000 +++ lisp/desktop.el 2013-08-02 04:33:58 +0000 @@ -134,6 +134,7 @@ ;;; Code: (require 'cl-lib) +(require 'frameset) (defvar desktop-file-version "206" "Version number of desktop file format. @@ -372,7 +373,7 @@ :group 'desktop) (defcustom desktop-restore-frames t - "When non-nil, save window/frame configuration to desktop file." + "When non-nil, save frames to desktop file." :type 'boolean :group 'desktop :version "24.4") @@ -399,7 +400,7 @@ :group 'desktop :version "24.4") -(defcustom desktop-restoring-reuses-frames t +(defcustom desktop-restore-reuses-frames t "If t, restoring frames reuses existing frames. If nil, existing frames are deleted. If `keep', existing frames are kept and not reused." @@ -409,13 +410,6 @@ :group 'desktop :version "24.4") -(defcustom desktop-before-saving-frames-functions nil - "Abnormal hook run before saving frames. -Functions in this hook are called with one argument, a live frame." - :type 'hook - :group 'desktop - :version "24.4") - (defcustom desktop-file-name-format 'absolute "Format in which desktop file names should be saved. Possible values are: @@ -599,7 +593,7 @@ "Checksum of the last auto-saved contents of the desktop file. Used to avoid writing contents unchanged between auto-saves.") -(defvar desktop-saved-frame-states nil +(defvar desktop-saved-frameset nil "Saved state of all frames. Only valid during frame saving & restoring; intended for internal use.") @@ -667,7 +661,17 @@ (unless (or (eq (aref bufname 0) ?\s) ;; Don't kill internal buffers (string-match-p preserve-regexp bufname)) (kill-buffer buffer))))) - (delete-other-windows)) + (delete-other-windows) + (let* ((this (selected-frame)) + (mini (window-frame (minibuffer-window this)))) ; in case they difer + (dolist (frame (sort (frame-list) #'frameset-sort-frames-for-deletion)) + (condition-case err + (unless (or (eq frame this) + (eq frame mini) + (frame-parameter frame 'desktop-dont-clear)) + (delete-frame frame)) + (error + (delay-warning 'desktop (error-message-string err))))))) ;; ---------------------------------------------------------------------------- (unless noninteractive @@ -890,223 +894,41 @@ ;; ---------------------------------------------------------------------------- (defvar desktop-filter-parameters-alist - '((background-color . desktop--filter-*-color) - (buffer-list . t) - (buffer-predicate . t) - (buried-buffer-list . t) - (desktop--font . desktop--filter-restore-desktop-parm) - (desktop--fullscreen . desktop--filter-restore-desktop-parm) - (desktop--height . desktop--filter-restore-desktop-parm) - (desktop--width . desktop--filter-restore-desktop-parm) - (font . desktop--filter-save-desktop-parm) - (font-backend . t) - (foreground-color . desktop--filter-*-color) - (fullscreen . desktop--filter-save-desktop-parm) - (height . desktop--filter-save-desktop-parm) - (left . desktop--filter-iconified-position) - (minibuffer . desktop--filter-minibuffer) - (name . t) - (outer-window-id . t) - (parent-id . t) - (top . desktop--filter-iconified-position) - (tty . desktop--filter-tty*) - (tty-type . desktop--filter-tty*) - (width . desktop--filter-save-desktop-parm) - (window-id . t) - (window-system . t)) + (append '((font-backend . t) + (name . t) + (outer-window-id . t) + (parent-id . t) + (tty . desktop--filter-tty*) + (tty-type . desktop--filter-tty*) + (window-id . t) + (window-system . t)) + frameset-filter-alist) "Alist of frame parameters and filtering functions. - -Each element is a cons (PARAM . FILTER), where PARAM is a parameter -name (a symbol identifying a frame parameter), and FILTER can be t -\(meaning the parameter is removed from the parameter list on saving -and restoring), or a function that will be called with three args: - - CURRENT a cons (PARAM . VALUE), where PARAM is the one being - filtered and VALUE is its current value - PARAMETERS the complete alist of parameters being filtered - SAVING non-nil if filtering before saving state, nil otherwise - -The FILTER function must return: - nil CURRENT is removed from the list - t CURRENT is left as is - (PARAM' . VALUE') replace CURRENT with this - -Frame parameters not on this list are passed intact.") - -(defvar desktop--target-display nil - "Either (minibuffer . VALUE) or nil. -This refers to the current frame config being processed inside -`frame--restore-frames' and its auxiliary functions (like filtering). -If nil, there is no need to change the display. -If non-nil, display parameter to use when creating the frame. -Internal use only.") - -(defun desktop-switch-to-gui-p (parameters) - "True when switching to a graphic display. -Return t if PARAMETERS describes a text-only terminal and -the target is a graphic display; otherwise return nil. -Only meaningful when called from a filtering function in -`desktop-filter-parameters-alist'." - (and desktop--target-display ; we're switching - (null (cdr (assq 'display parameters))) ; from a tty - (cdr desktop--target-display))) ; to a GUI display - -(defun desktop-switch-to-tty-p (parameters) - "True when switching to a text-only terminal. -Return t if PARAMETERS describes a graphic display and -the target is a text-only terminal; otherwise return nil. -Only meaningful when called from a filtering function in -`desktop-filter-parameters-alist'." - (and desktop--target-display ; we're switching - (cdr (assq 'display parameters)) ; from a GUI display - (null (cdr desktop--target-display)))) ; to a tty +Its format is identical to `frameset-filter-alist' (which see).") (defun desktop--filter-tty* (_current parameters saving) ;; Remove tty and tty-type parameters when switching ;; to a GUI frame. (or saving - (not (desktop-switch-to-gui-p parameters)))) - -(defun desktop--filter-*-color (current parameters saving) - ;; Remove (foreground|background)-color parameters - ;; when switching to a GUI frame if they denote an - ;; "unspecified" color. - (or saving - (not (desktop-switch-to-gui-p parameters)) - (not (stringp (cdr current))) - (not (string-match-p "^unspecified-[fb]g$" (cdr current))))) - -(defun desktop--filter-minibuffer (current _parameters saving) - ;; When minibuffer is a window, save it as minibuffer . t - (or (not saving) - (if (windowp (cdr current)) - '(minibuffer . t) - t))) - -(defun desktop--filter-restore-desktop-parm (current parameters saving) - ;; When switching to a GUI frame, convert desktop--XXX parameter to XXX - (or saving - (not (desktop-switch-to-gui-p parameters)) - (let ((val (cdr current))) - (if (eq val :desktop-processed) - nil - (cons (intern (substring (symbol-name (car current)) - 9)) ;; (length "desktop--") - val))))) - -(defun desktop--filter-save-desktop-parm (current parameters saving) - ;; When switching to a tty frame, save parameter XXX as desktop--XXX so it - ;; can be restored in a subsequent GUI session, unless it already exists. - (cond (saving t) - ((desktop-switch-to-tty-p parameters) - (let ((sym (intern (format "desktop--%s" (car current))))) - (if (assq sym parameters) - nil - (cons sym (cdr current))))) - ((desktop-switch-to-gui-p parameters) - (let* ((dtp (assq (intern (format "desktop--%s" (car current))) - parameters)) - (val (cdr dtp))) - (if (eq val :desktop-processed) - nil - (setcdr dtp :desktop-processed) - (cons (car current) val)))) - (t t))) - -(defun desktop--filter-iconified-position (_current parameters saving) - ;; When saving an iconified frame, top & left are meaningless, - ;; so remove them to allow restoring to a default position. - (not (and saving (eq (cdr (assq 'visibility parameters)) 'icon)))) - -(defun desktop-restore-in-original-display-p () - "True if saved frames' displays should be honored." - (cond ((daemonp) t) - ((eq system-type 'windows-nt) nil) - (t (null desktop-restore-in-current-display)))) - -(defun desktop--filter-frame-parms (parameters saving) - "Filter frame parameters and return filtered list. -PARAMETERS is a parameter alist as returned by `frame-parameters'. -If SAVING is non-nil, filtering is happening before saving frame state; -otherwise, filtering is being done before restoring frame state. -Parameters are filtered according to the setting of -`desktop-filter-parameters-alist' (which see). -Internal use only." - (let ((filtered nil)) - (dolist (param parameters) - (let ((filter (cdr (assq (car param) desktop-filter-parameters-alist))) - this) - (cond (;; no filter: pass param - (null filter) - (push param filtered)) - (;; filter = t; skip param - (eq filter t)) - (;; filter func returns nil: skip param - (null (setq this (funcall filter param parameters saving)))) - (;; filter func returns t: pass param - (eq this t) - (push param filtered)) - (;; filter func returns a new param: use it - t - (push this filtered))))) - ;; Set the display parameter after filtering, so that filter functions - ;; have access to its original value. - (when desktop--target-display - (let ((display (assq 'display filtered))) - (if display - (setcdr display (cdr desktop--target-display)) - (push desktop--target-display filtered)))) - filtered)) - -(defun desktop--process-minibuffer-frames (frames) - ;; Adds a desktop--mini parameter to frames - ;; desktop--mini is a list (MINIBUFFER NUMBER DEFAULT?) where - ;; MINIBUFFER t if the frame (including minibuffer-only) owns a minibuffer - ;; NUMBER if MINIBUFFER = t, an ID for the frame; if nil, the ID of - ;; the frame containing the minibuffer used by this frame - ;; DEFAULT? if t, this frame is the value of default-minibuffer-frame - (let ((count 0)) - ;; Reset desktop--mini for all frames - (dolist (frame (frame-list)) - (set-frame-parameter frame 'desktop--mini nil)) - ;; Number all frames with its own minibuffer - (dolist (frame (minibuffer-frame-list)) - (set-frame-parameter frame 'desktop--mini - (list t - (cl-incf count) - (eq frame default-minibuffer-frame)))) - ;; Now link minibufferless frames with their minibuffer frames - (dolist (frame frames) - (unless (frame-parameter frame 'desktop--mini) - (let ((mb-frame (window-frame (minibuffer-window frame)))) - ;; Frames whose minibuffer frame has been filtered out will have - ;; desktop--mini = nil, so desktop-restore-frames will restore them - ;; according to their minibuffer parameter. Set up desktop--mini - ;; for the rest. - (when (memq mb-frame frames) - (set-frame-parameter frame 'desktop--mini - (list nil - (cl-second (frame-parameter mb-frame 'desktop--mini)) - nil)))))))) - -(defun desktop-save-frames () - "Save frame state in `desktop-saved-frame-states'. -Runs the hook `desktop-before-saving-frames-functions'. + (not (frameset-switch-to-gui-p parameters)))) + +(defun desktop--check-dont-save (frame) + (not (frame-parameter frame 'desktop-dont-save))) + +(defconst desktop--app-id `(desktop . ,desktop-file-version)) + +(defun desktop-save-frameset () + "Save the state of existing frames in `desktop-saved-frameset'. Frames with a non-nil `desktop-dont-save' parameter are not saved." - (setq desktop-saved-frame-states + (setq desktop-saved-frameset (and desktop-restore-frames - (let ((frames (cl-delete-if - (lambda (frame) - (run-hook-with-args 'desktop-before-saving-frames-functions frame) - (frame-parameter frame 'desktop-dont-save)) - (frame-list)))) - ;; In case some frame was deleted by a hook function - (setq frames (cl-delete-if-not #'frame-live-p frames)) - (desktop--process-minibuffer-frames frames) - (mapcar (lambda (frame) - (cons (desktop--filter-frame-parms (frame-parameters frame) t) - (window-state-get (frame-root-window frame) t))) - frames))))) + (let ((name (concat user-login-name "@" system-name + (format-time-string " %Y-%m-%d %T")))) + (frameset-save nil + :filters desktop-filter-parameters-alist + :predicate #'desktop--check-dont-save + :properties (list :app desktop--app-id + :name name)))))) ;;;###autoload (defun desktop-save (dirname &optional release auto-save) @@ -1148,11 +970,11 @@ (insert "\n;; Global section:\n") ;; Called here because we save the window/frame state as a global ;; variable for compatibility with previous Emacsen. - (desktop-save-frames) - (unless (memq 'desktop-saved-frame-states desktop-globals-to-save) - (desktop-outvar 'desktop-saved-frame-states)) + (desktop-save-frameset) + (unless (memq 'desktop-saved-frameset desktop-globals-to-save) + (desktop-outvar 'desktop-saved-frameset)) (mapc (function desktop-outvar) desktop-globals-to-save) - (setq desktop-saved-frame-states nil) ; after saving desktop-globals-to-save + (setq desktop-saved-frameset nil) ; after saving desktop-globals-to-save (when (memq 'kill-ring desktop-globals-to-save) (insert "(setq kill-ring-yank-pointer (nthcdr " @@ -1210,319 +1032,26 @@ (defvar desktop-lazy-timer nil) ;; ---------------------------------------------------------------------------- -(defvar desktop--reuse-list nil - "Internal use only.") - -(defun desktop--compute-pos (value left/top right/bottom) - (pcase value - (`(+ ,val) (+ left/top val)) - (`(- ,val) (+ right/bottom val)) - (val val))) - -(defun desktop--move-onscreen (frame) - "If FRAME is offscreen, move it back onscreen and, if necessary, resize it. -When forced onscreen, frames wider than the monitor's workarea are converted -to fullwidth, and frames taller than the workarea are converted to fullheight. -NOTE: This only works for non-iconified frames." - (pcase-let* ((`(,left ,top ,width ,height) (cl-cdadr (frame-monitor-attributes frame))) - (right (+ left width -1)) - (bottom (+ top height -1)) - (fr-left (desktop--compute-pos (frame-parameter frame 'left) left right)) - (fr-top (desktop--compute-pos (frame-parameter frame 'top) top bottom)) - (ch-width (frame-char-width frame)) - (ch-height (frame-char-height frame)) - (fr-width (max (frame-pixel-width frame) (* ch-width (frame-width frame)))) - (fr-height (max (frame-pixel-height frame) (* ch-height (frame-height frame)))) - (fr-right (+ fr-left fr-width -1)) - (fr-bottom (+ fr-top fr-height -1))) - (when (pcase desktop-restore-forces-onscreen - ;; Any corner is outside the screen. - (`all (or (< fr-bottom top) (> fr-bottom bottom) - (< fr-left left) (> fr-left right) - (< fr-right left) (> fr-right right) - (< fr-top top) (> fr-top bottom))) - ;; Displaced to the left, right, above or below the screen. - (`t (or (> fr-left right) - (< fr-right left) - (> fr-top bottom) - (< fr-bottom top))) - (_ nil)) - (let ((fullwidth (> fr-width width)) - (fullheight (> fr-height height)) - (params nil)) - ;; Position frame horizontally. - (cond (fullwidth - (push `(left . ,left) params)) - ((> fr-right right) - (push `(left . ,(+ left (- width fr-width))) params)) - ((< fr-left left) - (push `(left . ,left) params))) - ;; Position frame vertically. - (cond (fullheight - (push `(top . ,top) params)) - ((> fr-bottom bottom) - (push `(top . ,(+ top (- height fr-height))) params)) - ((< fr-top top) - (push `(top . ,top) params))) - ;; Compute fullscreen state, if required. - (when (or fullwidth fullheight) - (push (cons 'fullscreen - (cond ((not fullwidth) 'fullheight) - ((not fullheight) 'fullwidth) - (t 'maximized))) - params)) - ;; Finally, move the frame back onscreen. - (when params - (modify-frame-parameters frame params)))))) - -(defun desktop--find-frame (predicate display &rest args) - "Find a suitable frame in `desktop--reuse-list'. -Look through frames whose display property matches DISPLAY and -return the first one for which (PREDICATE frame ARGS) returns t. -If PREDICATE is nil, it is always satisfied. Internal use only. -This is an auxiliary function for `desktop--select-frame'." - (cl-find-if (lambda (frame) - (and (equal (frame-parameter frame 'display) display) - (or (null predicate) - (apply predicate frame args)))) - desktop--reuse-list)) - -(defun desktop--select-frame (display frame-cfg) - "Look for an existing frame to reuse. -DISPLAY is the display where the frame will be shown, and FRAME-CFG -is the parameter list of the frame being restored. Internal use only." - (if (eq desktop-restoring-reuses-frames t) - (let ((frame nil) - mini) - ;; There are no fancy heuristics there. We could implement some - ;; based on frame size and/or position, etc., but it is not clear - ;; that any "gain" (in the sense of reduced flickering, etc.) is - ;; worth the added complexity. In fact, the code below mainly - ;; tries to work nicely when M-x desktop-read is used after a desktop - ;; session has already been loaded. The other main use case, which - ;; is the initial desktop-read upon starting Emacs, should usually - ;; only have one, or very few, frame(s) to reuse. - (cond ((null display) - ;; When the target is tty, every existing frame is reusable. - (setq frame (desktop--find-frame nil display))) - ((car (setq mini (cdr (assq 'desktop--mini frame-cfg)))) - ;; If the frame has its own minibuffer, let's see whether - ;; that frame has already been loaded (which can happen after - ;; M-x desktop-read). - (setq frame (desktop--find-frame - (lambda (f m) - (equal (frame-parameter f 'desktop--mini) m)) - display mini)) - ;; If it has not been loaded, and it is not a minibuffer-only frame, - ;; let's look for an existing non-minibuffer-only frame to reuse. - (unless (or frame (eq (cdr (assq 'minibuffer frame-cfg)) 'only)) - (setq frame (desktop--find-frame - (lambda (f) - (let ((w (frame-parameter f 'minibuffer))) - (and (window-live-p w) - (window-minibuffer-p w) - (eq (window-frame w) f)))) - display)))) - (mini - ;; For minibufferless frames, check whether they already exist, - ;; and that they are linked to the right minibuffer frame. - (setq frame (desktop--find-frame - (lambda (f n) - (pcase-let (((and m `(,hasmini ,num)) - (frame-parameter f 'desktop--mini))) - (and m - (null hasmini) - (= num n) - (equal (cl-second (frame-parameter - (window-frame (minibuffer-window f)) - 'desktop--mini)) - n)))) - display (cl-second mini)))) - (t - ;; Default to just finding a frame in the same display. - (setq frame (desktop--find-frame nil display)))) - ;; If found, remove from the list. - (when frame - (setq desktop--reuse-list (delq frame desktop--reuse-list))) - frame) - nil)) - -(defun desktop--make-frame (frame-cfg window-cfg) - "Set up a frame according to its saved state. -That means either creating a new frame or reusing an existing one. -FRAME-CFG is the parameter list of the new frame; WINDOW-CFG is -its window state. Internal use only." - (let* ((fullscreen (cdr (assq 'fullscreen frame-cfg))) - (lines (assq 'tool-bar-lines frame-cfg)) - (filtered-cfg (desktop--filter-frame-parms frame-cfg nil)) - (display (cdr (assq 'display filtered-cfg))) ;; post-filtering - alt-cfg frame) - - ;; This works around bug#14795 (or feature#14795, if not a bug :-) - (setq filtered-cfg (assq-delete-all 'tool-bar-lines filtered-cfg)) - (push '(tool-bar-lines . 0) filtered-cfg) - - (when fullscreen - ;; Currently Emacs has the limitation that it does not record the size - ;; and position of a frame before maximizing it, so we cannot save & - ;; restore that info. Instead, when restoring, we resort to creating - ;; invisible "fullscreen" frames of default size and then maximizing them - ;; (and making them visible) which at least is somewhat user-friendly - ;; when these frames are later de-maximized. - (let ((width (and (eq fullscreen 'fullheight) (cdr (assq 'width filtered-cfg)))) - (height (and (eq fullscreen 'fullwidth) (cdr (assq 'height filtered-cfg)))) - (visible (assq 'visibility filtered-cfg))) - (setq filtered-cfg (cl-delete-if (lambda (p) - (memq p '(visibility fullscreen width height))) - filtered-cfg :key #'car)) - (when width - (setq filtered-cfg (append `((user-size . t) (width . ,width)) - filtered-cfg))) - (when height - (setq filtered-cfg (append `((user-size . t) (height . ,height)) - filtered-cfg))) - ;; These are parameters to apply after creating/setting the frame. - (push visible alt-cfg) - (push (cons 'fullscreen fullscreen) alt-cfg))) - - ;; Time to find or create a frame an apply the big bunch of parameters. - ;; If a frame needs to be created and it falls partially or wholly offscreen, - ;; sometimes it gets "pushed back" onscreen; however, moving it afterwards is - ;; allowed. So we create the frame as invisible and then reapply the full - ;; parameter list (including position and size parameters). - (setq frame (or (desktop--select-frame display filtered-cfg) - (make-frame-on-display display - (cons '(visibility) - (cl-loop - for param in '(left top width height minibuffer) - collect (assq param filtered-cfg)))))) - (modify-frame-parameters frame - (if (eq (frame-parameter frame 'fullscreen) fullscreen) - ;; Workaround for bug#14949 - (assq-delete-all 'fullscreen filtered-cfg) - filtered-cfg)) - - ;; If requested, force frames to be onscreen. - (when (and desktop-restore-forces-onscreen - ;; FIXME: iconified frames should be checked too, - ;; but it is impossible without deiconifying them. - (not (eq (frame-parameter frame 'visibility) 'icon))) - (desktop--move-onscreen frame)) - - ;; Let's give the finishing touches (visibility, tool-bar, maximization). - (when lines (push lines alt-cfg)) - (when alt-cfg (modify-frame-parameters frame alt-cfg)) - ;; Now restore window state. - (window-state-put window-cfg (frame-root-window frame) 'safe) - frame)) - -(defun desktop--sort-states (state1 state2) - ;; Order: default minibuffer frame - ;; other frames with minibuffer, ascending ID - ;; minibufferless frames, ascending ID - (pcase-let ((`(,_p1 ,hasmini1 ,num1 ,default1) (assq 'desktop--mini (car state1))) - (`(,_p2 ,hasmini2 ,num2 ,default2) (assq 'desktop--mini (car state2)))) - (cond (default1 t) - (default2 nil) - ((eq hasmini1 hasmini2) (< num1 num2)) - (t hasmini1)))) - -(defun desktop-restoring-frames-p () - "True if calling `desktop-restore-frames' will actually restore frames." - (and desktop-restore-frames desktop-saved-frame-states t)) - -(defun desktop-restore-frames () - "Restore window/frame configuration. -This function depends on the value of `desktop-saved-frame-states' +(defun desktop-restoring-frameset-p () + "True if calling `desktop-restore-frameset' will actually restore it." + (and desktop-restore-frames desktop-saved-frameset t)) + +(defun desktop-restore-frameset () + "Restore the state of a set of frames. +This function depends on the value of `desktop-saved-frameset' being set (usually, by reading it from the desktop)." - (when (desktop-restoring-frames-p) - (let* ((frame-mb-map nil) ;; Alist of frames with their own minibuffer - (delete-saved (eq desktop-restore-in-current-display 'delete)) - (forcing (not (desktop-restore-in-original-display-p))) - (target (and forcing (cons 'display (frame-parameter nil 'display))))) - - ;; Sorting saved states allows us to easily restore minibuffer-owning frames - ;; before minibufferless ones. - (setq desktop-saved-frame-states (sort desktop-saved-frame-states - #'desktop--sort-states)) - ;; Potentially all existing frames are reusable. Later we will decide which ones - ;; to reuse, and how to deal with any leftover. - (setq desktop--reuse-list (frame-list)) - - (dolist (state desktop-saved-frame-states) - (condition-case err - (pcase-let* ((`(,frame-cfg . ,window-cfg) state) - ((and d-mini `(,hasmini ,num ,default)) - (cdr (assq 'desktop--mini frame-cfg))) - (frame nil) (to-tty nil)) - ;; Only set target if forcing displays and the target display is different. - (if (or (not forcing) - (equal target (or (assq 'display frame-cfg) '(display . nil)))) - (setq desktop--target-display nil) - (setq desktop--target-display target - to-tty (null (cdr target)))) - ;; Time to restore frames and set up their minibuffers as they were. - ;; We only skip a frame (thus deleting it) if either: - ;; - we're switching displays, and the user chose the option to delete, or - ;; - we're switching to tty, and the frame to restore is minibuffer-only. - (unless (and desktop--target-display - (or delete-saved - (and to-tty - (eq (cdr (assq 'minibuffer frame-cfg)) 'only)))) - - ;; Restore minibuffers. Some of this stuff could be done in a filter - ;; function, but it would be messy because restoring minibuffers affects - ;; global state; it's best to do it here than add a bunch of global - ;; variables to pass info back-and-forth to/from the filter function. - (cond - ((null d-mini)) ;; No desktop--mini. Process as normal frame. - (to-tty) ;; Ignore minibuffer stuff and process as normal frame. - (hasmini ;; Frame has minibuffer (or it is minibuffer-only). - (when (eq (cdr (assq 'minibuffer frame-cfg)) 'only) - (setq frame-cfg (append '((tool-bar-lines . 0) (menu-bar-lines . 0)) - frame-cfg)))) - (t ;; Frame depends on other frame's minibuffer window. - (let ((mb-frame (cdr (assq num frame-mb-map)))) - (unless (frame-live-p mb-frame) - (error "Minibuffer frame %s not found" num)) - (let ((mb-param (assq 'minibuffer frame-cfg)) - (mb-window (minibuffer-window mb-frame))) - (unless (and (window-live-p mb-window) - (window-minibuffer-p mb-window)) - (error "Not a minibuffer window %s" mb-window)) - (if mb-param - (setcdr mb-param mb-window) - (push (cons 'minibuffer mb-window) frame-cfg)))))) - ;; OK, we're ready at last to create (or reuse) a frame and - ;; restore the window config. - (setq frame (desktop--make-frame frame-cfg window-cfg)) - ;; Set default-minibuffer if required. - (when default (setq default-minibuffer-frame frame)) - ;; Store NUM/frame to assign to minibufferless frames. - (when hasmini (push (cons num frame) frame-mb-map)))) - (error - (delay-warning 'desktop (error-message-string err) :error)))) - - ;; In case we try to delete the initial frame, we want to make sure that - ;; other frames are already visible (discussed in thread for bug#14841). - (sit-for 0 t) - - ;; Delete remaining frames, but do not fail if some resist being deleted. - (unless (eq desktop-restoring-reuses-frames 'keep) - (dolist (frame desktop--reuse-list) - (condition-case err - (delete-frame frame) - (error - (delay-warning 'desktop (error-message-string err)))))) - (setq desktop--reuse-list nil) - ;; Make sure there's at least one visible frame, and select it. - (unless (or (daemonp) - (cl-find-if #'frame-visible-p (frame-list))) - (let ((visible (if (frame-live-p default-minibuffer-frame) - default-minibuffer-frame - (car (frame-list))))) - (make-frame-visible visible) - (select-frame-set-input-focus visible)))))) + (when (desktop-restoring-frameset-p) + (frameset-restore desktop-saved-frameset + :filters desktop-filter-parameters-alist + :reuse-frames desktop-restore-reuses-frames + :force-display desktop-restore-in-current-display + :force-onscreen desktop-restore-forces-onscreen))) + +;; Just to silence the byte compiler. +;; Dynamicaly bound in `desktop-read'. +(defvar desktop-first-buffer) +(defvar desktop-buffer-ok-count) +(defvar desktop-buffer-fail-count) ;;;###autoload (defun desktop-read (&optional dirname) @@ -1583,7 +1112,7 @@ (file-error (message "Couldn't record use of desktop file") (sit-for 1)))) - (unless (desktop-restoring-frames-p) + (unless (desktop-restoring-frameset-p) ;; `desktop-create-buffer' puts buffers at end of the buffer list. ;; We want buffers existing prior to evaluating the desktop (and ;; not reused) to be placed at the end of the buffer list, so we @@ -1593,9 +1122,14 @@ (switch-to-buffer (car (buffer-list)))) (run-hooks 'desktop-delay-hook) (setq desktop-delay-hook nil) - (desktop-restore-frames) + (desktop-restore-frameset) (run-hooks 'desktop-after-read-hook) - (message "Desktop: %d buffer%s restored%s%s." + (message "Desktop: %s%d buffer%s restored%s%s." + (if desktop-saved-frameset + (let ((fn (length (frameset-states desktop-saved-frameset)))) + (format "%d frame%s, " + fn (if (= fn 1) "" "s"))) + "") desktop-buffer-ok-count (if (= 1 desktop-buffer-ok-count) "" "s") (if (< 0 desktop-buffer-fail-count) @@ -1605,7 +1139,7 @@ (format ", %d to restore lazily" (length desktop-buffer-args-list)) "")) - (unless (desktop-restoring-frames-p) + (unless (desktop-restoring-frameset-p) ;; Bury the *Messages* buffer to not reshow it when burying ;; the buffer we switched to above. (when (buffer-live-p (get-buffer "*Messages*")) @@ -1743,14 +1277,6 @@ ;; Create a buffer, load its file, set its mode, ...; ;; called from Desktop file only. -;; Just to silence the byte compiler. - -(defvar desktop-first-buffer) ; Dynamically bound in `desktop-read' - -;; Bound locally in `desktop-read'. -(defvar desktop-buffer-ok-count) -(defvar desktop-buffer-fail-count) - (defun desktop-create-buffer (file-version buffer-filename === added file 'lisp/frameset.el' --- lisp/frameset.el 1970-01-01 00:00:00 +0000 +++ lisp/frameset.el 2013-08-02 04:33:58 +0000 @@ -0,0 +1,675 @@ +;;; frameset.el --- save and restore frame and window setup -*- lexical-binding: t -*- + +;; Copyright (C) 2013 Free Software Foundation, Inc. + +;; Author: Juanma Barranquero +;; Keywords: convenience + +;; This file is part of GNU Emacs. + +;; GNU Emacs 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 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs 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 GNU Emacs. If not, see . + +;;; Commentary: + +;; This file provides a set of operations to save a frameset (the state +;; of all or a subset of the existing frames and windows), both +;; in-session and persistently, and restore it at some point in the +;; future. +;; +;; It should be noted that restoring the frames' windows depends on +;; the buffers they are displaying, but this package does not provide +;; any way to save and restore sets of buffers (see desktop.el for +;; that). So, it's up to the user of frameset.el to make sure that +;; any relevant buffer is loaded before trying to restore a frameset. +;; When a window is restored and a buffer is missing, the window will +;; be deleted unless it is the last one in the frame, in which case +;; some previous buffer will be shown instead. + +;;; Code: + +(require 'cl-lib) + + +;; Framesets have two fields: +;; - properties: a property list to store both frameset-specific and +;; user-defined serializable data. Currently defined properties +;; include: +;; :version ID - Identifies the version of the frameset struct; +;; this is the only property always present and +;; must not be modified. +;; :app APPINFO - Freeform. Can be used by applications and +;; packages to indicate the intended (but by no +;; means exclusive) use of the frameset. For +;; example, currently desktop.el sets :app to +;; `(desktop . ,desktop-file-version). +;; :name NAME - The name of the frameset instance; a string. +;; :desc TEXT - A description for user consumption (to choose +;; among framesets, etc.); a string. +;; - states: an alist of items (FRAME-PARAMETERS . WINDOW-STATE) in +;; no particular order. Each item represents a frame to be +;; restored. + +(cl-defstruct (frameset (:type list) :named + (:copier nil) + (:predicate nil)) + properties ;; property list + states) ;; list of conses (frame-state . window-state) + +(defun copy-frameset (frameset) + "Return a copy of FRAMESET. +This is a deep copy done with `copy-tree'." + (copy-tree frameset t)) + +;;;autoload +(defun frameset-p (frameset) + "If FRAMESET is a frameset, return its :version. +Else return nil." + (and (eq (car-safe frameset) 'frameset) + (plist-get (cl-second frameset) :version))) + + +;; Filtering + +(defvar frameset-filter-alist + '((background-color . frameset-filter-sanitize-color) + (buffer-list . t) + (buffer-predicate . t) + (buried-buffer-list . t) + (font . frameset-filter-save-parm) + (foreground-color . frameset-filter-sanitize-color) + (fullscreen . frameset-filter-save-parm) + (GUI:font . frameset-filter-restore-parm) + (GUI:fullscreen . frameset-filter-restore-parm) + (GUI:height . frameset-filter-restore-parm) + (GUI:width . frameset-filter-restore-parm) + (height . frameset-filter-save-parm) + (left . frameset-filter-iconified) + (minibuffer . frameset-filter-minibuffer) + (top . frameset-filter-iconified) + (width . frameset-filter-save-parm)) + "Alist of frame parameters and filtering functions. + +Each element is a cons (PARAM . ACTION), where PARAM is a parameter +name (a symbol identifying a frame parameter), and ACTION can be: + + t The parameter is always removed from the parameter list. + :save The parameter is removed when saving the frame. + :restore The parameter is removed when restoring the frame. + FILTER A filter function. + +FILTER can be a symbol FILTER-FUN, or a list (FILTER-FUN ARGS...). +It will be called with four arguments CURRENT, FILTERED, PARAMETERS +and SAVING, plus any additional ARGS: + + CURRENT A cons (PARAM . VALUE), where PARAM is the one being + filtered and VALUE is its current value. + FILTERED The alist of parameters filtered so far. + PARAMETERS The complete alist of parameters being filtered, + SAVING Non-nil if filtering before saving state, nil otherwise. + +The FILTER-FUN function must return: + nil CURRENT is removed from the list. + t CURRENT is left as is. + (PARAM' . VALUE') Replace CURRENT with this. + +Frame parameters not on this list are passed intact.") + +(defvar frameset--target-display nil + ;; Either (minibuffer . VALUE) or nil. + ;; This refers to the current frame config being processed inside + ;; `frame--restore-frames' and its auxiliary functions (like filtering). + ;; If nil, there is no need to change the display. + ;; If non-nil, display parameter to use when creating the frame. + "Internal use only.") + +(defun frameset-switch-to-gui-p (parameters) + "True when switching to a graphic display. +Return t if PARAMETERS describes a text-only terminal and +the target is a graphic display; otherwise return nil. +Only meaningful when called from a filtering function in +`frameset-filter-alist'." + (and frameset--target-display ; we're switching + (null (cdr (assq 'display parameters))) ; from a tty + (cdr frameset--target-display))) ; to a GUI display + +(defun frameset-switch-to-tty-p (parameters) + "True when switching to a text-only terminal. +Return t if PARAMETERS describes a graphic display and +the target is a text-only terminal; otherwise return nil. +Only meaningful when called from a filtering function in +`frameset-filter-alist'." + (and frameset--target-display ; we're switching + (cdr (assq 'display parameters)) ; from a GUI display + (null (cdr frameset--target-display)))) ; to a tty + +(defun frameset-filter-sanitize-color (current _filtered parameters saving) + "When switching to a GUI frame, remove \"unspecified\" colors. +Useful as a filter function for tty-specific parameters." + (or saving + (not (frameset-switch-to-gui-p parameters)) + (not (stringp (cdr current))) + (not (string-match-p "^unspecified-[fb]g$" (cdr current))))) + +(defun frameset-filter-minibuffer (current _filtered _parameters saving) + "Convert (minibuffer . #) parameter to (minibuffer . t)." + (or (not saving) + (if (windowp (cdr current)) + '(minibuffer . t) + t))) + +(defun frameset-filter-save-parm (current _filtered parameters saving + &optional prefix) + "When switching to a tty frame, save parameter P as PREFIX:P. +The parameter can be later restored with `frameset-filter-restore-parm'. +PREFIX defaults to `GUI'." + (unless prefix (setq prefix 'GUI)) + (cond (saving t) + ((frameset-switch-to-tty-p parameters) + (let ((prefix:p (intern (format "%s:%s" prefix (car current))))) + (if (assq prefix:p parameters) + nil + (cons prefix:p (cdr current))))) + ((frameset-switch-to-gui-p parameters) + (not (assq (intern (format "%s:%s" prefix (car current))) parameters))) + (t t))) + +(defun frameset-filter-restore-parm (current filtered parameters saving) + "When switching to a GUI frame, restore PREFIX:P parameter as P. +CURRENT must be of the form (PREFIX:P . value)." + (or saving + (not (frameset-switch-to-gui-p parameters)) + (let* ((prefix:p (symbol-name (car current))) + (p (intern (substring prefix:p + (1+ (string-match-p ":" prefix:p))))) + (val (cdr current)) + (found (assq p filtered))) + (if (not found) + (cons p val) + (setcdr found val) + nil)))) + +(defun frameset-filter-iconified (_current _filtered parameters saving) + "Remove CURRENT when saving an iconified frame. +This is used for positions parameters `left' and `top', which are +meaningless in an iconified frame, so the frame is restored in a +default position." + (not (and saving (eq (cdr (assq 'visibility parameters)) 'icon)))) + +(defun frameset-keep-original-display-p (force-display) + "True if saved frames' displays should be honored." + (cond ((daemonp) t) + ((eq system-type 'windows-nt) nil) + (t (null force-display)))) + +(defun frameset-filter-params (parameters filter-alist saving) + "Filter parameter list PARAMETERS and return a filtered list. +FILTER-ALIST is an alist of parameter filters, in the format of +`frameset-filter-alist' (which see). +SAVING is non-nil while filtering parameters to save a frameset, +nil while the filtering is done to restore it." + (let ((filtered nil)) + (dolist (current parameters) + (pcase (cdr (assq (car current) filter-alist)) + (`nil + (push current filtered)) + (`t + nil) + (:save + (unless saving (push current filtered))) + (:restore + (when saving (push current filtered))) + ((or `(,fun . ,args) (and fun (pred fboundp))) + (let ((this (apply fun filtered current parameters saving args))) + (when this + (push (if (eq this t) current this) filtered)))) + (other + (delay-warning 'frameset (format "Unknown filter %S" other) :error)))) + ;; Set the display parameter after filtering, so that filter functions + ;; have access to its original value. + (when frameset--target-display + (let ((display (assq 'display filtered))) + (if display + (setcdr display (cdr frameset--target-display)) + (push frameset--target-display filtered)))) + filtered)) + + +;; Saving framesets + +(defun frameset--set-id (frame) + "Set FRAME's `frameset-id' if not yet set. +Internal use only." + (unless (frame-parameter frame 'frameset-id) + (set-frame-parameter frame + 'frameset-id + (mapconcat (lambda (n) (format "%04X" n)) + (cl-loop repeat 4 collect (random 65536)) + "-")))) + +(defun frameset--process-minibuffer-frames (frame-list) + "Process FRAME-LIST and record minibuffer relationships. +FRAME-LIST is a list of frames." + ;; Record frames with their own minibuffer + (dolist (frame (minibuffer-frame-list)) + (when (memq frame frame-list) + (frameset--set-id frame) + ;; For minibuffer-owning frames, frameset--mini is a cons + ;; (t . DEFAULT?), where DEFAULT? is a boolean indicating whether + ;; the frame is the one pointed out by `default-minibuffer-frame'. + (set-frame-parameter frame + 'frameset--mini + (cons t (eq frame default-minibuffer-frame))))) + ;; Now link minibufferless frames with their minibuffer frames + (dolist (frame frame-list) + (unless (frame-parameter frame 'frameset--mini) + (frameset--set-id frame) + (let* ((mb-frame (window-frame (minibuffer-window frame))) + (id (and mb-frame (frame-parameter mb-frame 'frameset-id)))) + (if (null id) + (error "Minibuffer frame %S for %S is excluded" mb-frame frame) + ;; For minibufferless frames, frameset--mini is a cons + ;; (nil . FRAME-ID), where FRAME-ID is the frameset-id of + ;; the frame containing its minibuffer window. + (set-frame-parameter frame + 'frameset--mini + (cons nil id))))))) + +;;;autoload +(cl-defun frameset-save (frame-list &key filters predicate properties) + "Return the frameset of FRAME-LIST, a list of frames. +If nil, FRAME-LIST defaults to all live frames. +FILTERS is an alist of parameter filters; defaults to `frameset-filter-alist'. +PREDICATE is a predicate function, which must return non-nil for frames that +should be saved; it defaults to saving all frames from FRAME-LIST. +PROPERTIES is a user-defined property list to add to the frameset." + (let ((frames (cl-delete-if-not #'frame-live-p + (cl-remove-if-not (or predicate #'framep) + (or frame-list (frame-list)))))) + (frameset--process-minibuffer-frames frames) + (make-frameset :properties (append '(:version 1) properties) + :states (mapcar + (lambda (frame) + (cons + (frameset-filter-params (frame-parameters frame) + (or filters + frameset-filter-alist) + t) + (window-state-get (frame-root-window frame) t))) + frames)))) + + +;; Restoring framesets + +(defvar frameset--reuse-list nil + "Internal use only.") + +(defun frameset--compute-pos (value left/top right/bottom) + (pcase value + (`(+ ,val) (+ left/top val)) + (`(- ,val) (+ right/bottom val)) + (val val))) + +(defun frameset--move-onscreen (frame force-onscreen) + "If FRAME is offscreen, move it back onscreen and, if necessary, resize it. +For the description of FORCE-ONSCREEN, see `frameset-restore'. +When forced onscreen, frames wider than the monitor's workarea are converted +to fullwidth, and frames taller than the workarea are converted to fullheight. +NOTE: This only works for non-iconified frames. Internal use only." + (pcase-let* ((`(,left ,top ,width ,height) (cl-cdadr (frame-monitor-attributes frame))) + (right (+ left width -1)) + (bottom (+ top height -1)) + (fr-left (frameset--compute-pos (frame-parameter frame 'left) left right)) + (fr-top (frameset--compute-pos (frame-parameter frame 'top) top bottom)) + (ch-width (frame-char-width frame)) + (ch-height (frame-char-height frame)) + (fr-width (max (frame-pixel-width frame) (* ch-width (frame-width frame)))) + (fr-height (max (frame-pixel-height frame) (* ch-height (frame-height frame)))) + (fr-right (+ fr-left fr-width -1)) + (fr-bottom (+ fr-top fr-height -1))) + (when (pcase force-onscreen + ;; Any corner is outside the screen. + (`all (or (< fr-bottom top) (> fr-bottom bottom) + (< fr-left left) (> fr-left right) + (< fr-right left) (> fr-right right) + (< fr-top top) (> fr-top bottom))) + ;; Displaced to the left, right, above or below the screen. + (`t (or (> fr-left right) + (< fr-right left) + (> fr-top bottom) + (< fr-bottom top))) + ;; Fully inside, no need to do anything. + (_ nil)) + (let ((fullwidth (> fr-width width)) + (fullheight (> fr-height height)) + (params nil)) + ;; Position frame horizontally. + (cond (fullwidth + (push `(left . ,left) params)) + ((> fr-right right) + (push `(left . ,(+ left (- width fr-width))) params)) + ((< fr-left left) + (push `(left . ,left) params))) + ;; Position frame vertically. + (cond (fullheight + (push `(top . ,top) params)) + ((> fr-bottom bottom) + (push `(top . ,(+ top (- height fr-height))) params)) + ((< fr-top top) + (push `(top . ,top) params))) + ;; Compute fullscreen state, if required. + (when (or fullwidth fullheight) + (push (cons 'fullscreen + (cond ((not fullwidth) 'fullheight) + ((not fullheight) 'fullwidth) + (t 'maximized))) + params)) + ;; Finally, move the frame back onscreen. + (when params + (modify-frame-parameters frame params)))))) + +(defun frameset--find-frame (predicate display &rest args) + "Find a frame in `frameset--reuse-list' satisfying PREDICATE. +Look through available frames whose display property matches DISPLAY +and return the first one for which (PREDICATE frame ARGS) returns t. +If PREDICATE is nil, it is always satisfied. Internal use only." + (cl-find-if (lambda (frame) + (and (equal (frame-parameter frame 'display) display) + (or (null predicate) + (apply predicate frame args)))) + frameset--reuse-list)) + +(defun frameset--reuse-frame (display frame-cfg) + "Look for an existing frame to reuse. +DISPLAY is the display where the frame will be shown, and FRAME-CFG +is the parameter list of the frame being restored. Internal use only." + (let ((frame nil) + mini) + ;; There are no fancy heuristics there. We could implement some + ;; based on frame size and/or position, etc., but it is not clear + ;; that any "gain" (in the sense of reduced flickering, etc.) is + ;; worth the added complexity. In fact, the code below mainly + ;; tries to work nicely when M-x desktop-read is used after a + ;; desktop session has already been loaded. The other main use + ;; case, which is the initial desktop-read upon starting Emacs, + ;; will usually have only one frame, and should already work. + (cond ((null display) + ;; When the target is tty, every existing frame is reusable. + (setq frame (frameset--find-frame nil display))) + ((car (setq mini (cdr (assq 'frameset--mini frame-cfg)))) + ;; If the frame has its own minibuffer, let's see whether + ;; that frame has already been loaded (which can happen after + ;; M-x desktop-read). + (setq frame (frameset--find-frame + (lambda (f id) + (string= (frame-parameter f 'frameset-id) id)) + display (cdr mini))) + ;; If it has not been loaded, and it is not a minibuffer-only frame, + ;; let's look for an existing non-minibuffer-only frame to reuse. + (unless (or frame (eq (cdr (assq 'minibuffer frame-cfg)) 'only)) + (setq frame (frameset--find-frame + (lambda (f) + (let ((w (frame-parameter f 'minibuffer))) + (and (window-live-p w) + (window-minibuffer-p w) + (eq (window-frame w) f)))) + display)))) + (mini + ;; For minibufferless frames, check whether they already exist, + ;; and that they are linked to the right minibuffer frame. + (setq frame (frameset--find-frame + (lambda (f id mini-id) + (and (string= (frame-parameter f 'frameset-id) id) + (string= (frame-parameter (window-frame (minibuffer-window f)) + 'frameset-id) + mini-id))) + display (cdr (assq 'frameset-id frame-cfg)) (cdr mini)))) + (t + ;; Default to just finding a frame in the same display. + (setq frame (frameset--find-frame nil display)))) + ;; If found, remove from the list. + (when frame + (setq frameset--reuse-list (delq frame frameset--reuse-list))) + frame)) + +(defun frameset--get-frame (frame-cfg window-cfg filters force-onscreen) + "Set up and return a frame according to its saved state. +That means either reusing an existing frame or creating one anew. +FRAME-CFG is the frame's parameter list; WINDOW-CFG is its window state. +For the meaning of FORCE-ONSCREEN, see `frameset-restore'." + (let* ((fullscreen (cdr (assq 'fullscreen frame-cfg))) + (lines (assq 'tool-bar-lines frame-cfg)) + (filtered-cfg (frameset-filter-params frame-cfg filters nil)) + (display (cdr (assq 'display filtered-cfg))) ;; post-filtering + alt-cfg frame) + + ;; This works around bug#14795 (or feature#14795, if not a bug :-) + (setq filtered-cfg (assq-delete-all 'tool-bar-lines filtered-cfg)) + (push '(tool-bar-lines . 0) filtered-cfg) + + (when fullscreen + ;; Currently Emacs has the limitation that it does not record the size + ;; and position of a frame before maximizing it, so we cannot save & + ;; restore that info. Instead, when restoring, we resort to creating + ;; invisible "fullscreen" frames of default size and then maximizing them + ;; (and making them visible) which at least is somewhat user-friendly + ;; when these frames are later de-maximized. + (let ((width (and (eq fullscreen 'fullheight) (cdr (assq 'width filtered-cfg)))) + (height (and (eq fullscreen 'fullwidth) (cdr (assq 'height filtered-cfg)))) + (visible (assq 'visibility filtered-cfg))) + (setq filtered-cfg (cl-delete-if (lambda (p) + (memq p '(visibility fullscreen width height))) + filtered-cfg :key #'car)) + (when width + (setq filtered-cfg (append `((user-size . t) (width . ,width)) + filtered-cfg))) + (when height + (setq filtered-cfg (append `((user-size . t) (height . ,height)) + filtered-cfg))) + ;; These are parameters to apply after creating/setting the frame. + (push visible alt-cfg) + (push (cons 'fullscreen fullscreen) alt-cfg))) + + ;; Time to find or create a frame an apply the big bunch of parameters. + ;; If a frame needs to be created and it falls partially or fully offscreen, + ;; sometimes it gets "pushed back" onscreen; however, moving it afterwards is + ;; allowed. So we create the frame as invisible and then reapply the full + ;; parameter list (including position and size parameters). + (setq frame (or (and frameset--reuse-list + (frameset--reuse-frame display filtered-cfg)) + (make-frame-on-display display + (cons '(visibility) + (cl-loop + for param in '(left top width height minibuffer) + collect (assq param filtered-cfg)))))) + (modify-frame-parameters frame + (if (eq (frame-parameter frame 'fullscreen) fullscreen) + ;; Workaround for bug#14949 + (assq-delete-all 'fullscreen filtered-cfg) + filtered-cfg)) + + ;; If requested, force frames to be onscreen. + (when (and force-onscreen + ;; FIXME: iconified frames should be checked too, + ;; but it is impossible without deiconifying them. + (not (eq (frame-parameter frame 'visibility) 'icon))) + (frameset--move-onscreen frame force-onscreen)) + + ;; Let's give the finishing touches (visibility, tool-bar, maximization). + (when lines (push lines alt-cfg)) + (when alt-cfg (modify-frame-parameters frame alt-cfg)) + ;; Now restore window state. + (window-state-put window-cfg (frame-root-window frame) 'safe) + frame)) + +(defun frameset--sort-states (state1 state2) + "Predicate to sort frame states in a suitable order to be created. +It sorts minibuffer-owning frames before minibufferless ones." + (pcase-let ((`(,hasmini1 ,id-def1) (assq 'frameset--mini (car state1))) + (`(,hasmini2 ,id-def2) (assq 'frameset--mini (car state2)))) + (cond ((eq id-def1 t) t) + ((eq id-def2 t) nil) + ((not (eq hasmini1 hasmini2)) (eq hasmini1 t)) + ((eq hasmini1 nil) (string< id-def1 id-def2)) + (t t)))) + +(defun frameset-sort-frames-for-deletion (frame1 _frame2) + "Predicate to sort live frames for deletion. +Minibufferless frames must go first to avoid errors when attempting +to delete a frame whose minibuffer window is used by another frame." + (not (frame-parameter frame1 'minibuffer))) + +;;;autoload +(cl-defun frameset-restore (frameset &key filters reuse-frames force-display force-onscreen) + "Restore a FRAMESET into the current display(s). + +FILTERS is a list of parameter filters; defaults to `frameset-filter-alist'. + +REUSE-FRAMES describes how to reuse existing frames while restoring a frameset: + t Reuse any existing frame if possible; delete leftover frames. + nil Restore frameset in new frames and delete existing frames. + keep Restore frameset in new frames and keep the existing ones. + LIST A list of frames to reuse; only these will be reused, if possible, + and any leftover one will be deleted; other frames not on this + list will be kept. + +FORCE-DISPLAY can be: + t Frames will be restored in the current display. + nil Frames will be restored, if possible, in their original displays. + delete Frames in other displays will be deleted instead of restored. + +FORCE-ONSCREEN can be: + all Force onscreen any frame fully or partially offscreen. + t Force onscreen only those frames that are fully offscreen. + nil Do not force any frame back onscreen. + +All keywords default to nil." + + (cl-assert (frameset-p frameset)) + + (let* ((delete-saved (eq force-display 'delete)) + (forcing (not (frameset-keep-original-display-p force-display))) + (target (and forcing (cons 'display (frame-parameter nil 'display)))) + other-frames) + + ;; frameset--reuse-list is a list of frames potentially reusable. Later we + ;; will decide which ones can be reused, and how to deal with any leftover. + (pcase reuse-frames + ((or `nil `keep) + (setq frameset--reuse-list nil + other-frames (frame-list))) + ((pred consp) + (setq frameset--reuse-list (copy-sequence reuse-frames) + other-frames (cl-delete-if (lambda (frame) + (memq frame frameset--reuse-list)) + (frame-list)))) + (_ + (setq frameset--reuse-list (frame-list) + other-frames nil))) + + ;; Sort saved states to guarantee that minibufferless frames will be created + ;; after the frames that contain their minibuffer windows. + (dolist (state (sort (copy-sequence (frameset-states frameset)) + #'frameset--sort-states)) + (condition-case-unless-debug err + (pcase-let* ((`(,frame-cfg . ,window-cfg) state) + ((and d-mini `(,hasmini . ,mb-id)) + (cdr (assq 'frameset--mini frame-cfg))) + (default (and (booleanp mb-id) mb-id)) + (frame nil) (to-tty nil)) + ;; Only set target if forcing displays and the target display is different. + (if (or (not forcing) + (equal target (or (assq 'display frame-cfg) '(display . nil)))) + (setq frameset--target-display nil) + (setq frameset--target-display target + to-tty (null (cdr target)))) + ;; If keeping non-reusable frames, and the frame-id of one of them + ;; matches the frame-id of a frame being restored (because, for example, + ;; the frameset has already been read in the same session), remove the + ;; frame-id from the non-reusable frame, which is not useful anymore. + (when (and other-frames + (or (eq reuse-frames 'keep) (consp reuse-frames))) + (let ((dup (cl-find (cdr (assq 'frameset-frame-id frame-cfg)) + other-frames + :key (lambda (frame) + (frame-parameter frame 'frameset-frame-id)) + :test #'string=))) + (when dup + (set-frame-parameter dup 'frameset-frame-id nil)))) + ;; Time to restore frames and set up their minibuffers as they were. + ;; We only skip a frame (thus deleting it) if either: + ;; - we're switching displays, and the user chose the option to delete, or + ;; - we're switching to tty, and the frame to restore is minibuffer-only. + (unless (and frameset--target-display + (or delete-saved + (and to-tty + (eq (cdr (assq 'minibuffer frame-cfg)) 'only)))) + + ;; Restore minibuffers. Some of this stuff could be done in a filter + ;; function, but it would be messy because restoring minibuffers affects + ;; global state; it's best to do it here than add a bunch of global + ;; variables to pass info back-and-forth to/from the filter function. + (cond + ((null d-mini)) ;; No frameset--mini. Process as normal frame. + (to-tty) ;; Ignore minibuffer stuff and process as normal frame. + (hasmini ;; Frame has minibuffer (or it is minibuffer-only). + (when (eq (cdr (assq 'minibuffer frame-cfg)) 'only) + (setq frame-cfg (append '((tool-bar-lines . 0) (menu-bar-lines . 0)) + frame-cfg)))) + (t ;; Frame depends on other frame's minibuffer window. + (let* ((mb-frame (or (cl-find-if + (lambda (f) + (string= (frame-parameter f 'frameset-id) + mb-id)) + (frame-list)) + (error "Minibuffer frame %S not found" mb-id))) + (mb-param (assq 'minibuffer frame-cfg)) + (mb-window (minibuffer-window mb-frame))) + (unless (and (window-live-p mb-window) + (window-minibuffer-p mb-window)) + (error "Not a minibuffer window %s" mb-window)) + (if mb-param + (setcdr mb-param mb-window) + (push (cons 'minibuffer mb-window) frame-cfg)))))) + ;; OK, we're ready at last to create (or reuse) a frame and + ;; restore the window config. + (setq frame (frameset--get-frame frame-cfg window-cfg + (or filters frameset-filter-alist) + force-onscreen)) + ;; Set default-minibuffer if required. + (when default (setq default-minibuffer-frame frame))) + (error + (delay-warning 'frameset (error-message-string err) :error)))) + + ;; In case we try to delete the initial frame, we want to make sure that + ;; other frames are already visible (discussed in thread for bug#14841). + (sit-for 0 t) + + ;; Delete remaining frames, but do not fail if some resist being deleted. + (unless (eq reuse-frames 'keep) + (dolist (frame (sort (nconc (if (listp reuse-frames) nil other-frames) + frameset--reuse-list) + #'frameset-sort-frames-for-deletion)) + (condition-case err + (delete-frame frame) + (error + (delay-warning 'frameset (error-message-string err)))))) + (setq frameset--reuse-list nil) + + ;; Make sure there's at least one visible frame. + (unless (or (daemonp) (visible-frame-list)) + (make-frame-visible (car (frame-list)))))) + +(provide 'frameset) + +;;; frameset.el ends here ------------------------------------------------------------ revno: 113647 committer: Dmitry Antipov branch nick: trunk timestamp: Fri 2013-08-02 08:21:51 +0400 message: * w32term.c (x_unfocus_frame): Remove unused dummy function. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-08-02 03:55:24 +0000 +++ src/ChangeLog 2013-08-02 04:21:51 +0000 @@ -8,6 +8,7 @@ (update_frame_menubar, set_frame_menubar, free_frame_menubar) (create_and_show_popup_menu, xmenu_show, create_and_show_dialog) (xdialog_show): Use eassert for debugging check. + * w32term.c (x_unfocus_frame): Remove unused dummy function. 2013-08-01 Paul Eggert === modified file 'src/w32term.c' --- src/w32term.c 2013-08-01 06:38:49 +0000 +++ src/w32term.c 2013-08-02 04:21:51 +0000 @@ -5889,11 +5889,6 @@ unblock_input (); } -void -x_unfocus_frame (struct frame *f) -{ -} - /* Raise frame F. */ void x_raise_frame (struct frame *f) ------------------------------------------------------------ revno: 113646 committer: Dmitry Antipov branch nick: trunk timestamp: Fri 2013-08-02 07:55:24 +0400 message: * xterm.h (struct x_output) [HAVE_X_I18N]: Remove xic_base_fontname member which is not really used any more. (FRAME_XIC_BASE_FONTNAME): Remove. * xfns.c (xic_free_fontset): Adjust user. * xmenu.c (mouse_position_for_popup, x_activate_menubar) (update_frame_menubar, set_frame_menubar, free_frame_menubar) (create_and_show_popup_menu, xmenu_show, create_and_show_dialog) (xdialog_show): Use eassert for debugging check. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-08-01 22:53:03 +0000 +++ src/ChangeLog 2013-08-02 03:55:24 +0000 @@ -1,3 +1,14 @@ +2013-08-02 Dmitry Antipov + + * xterm.h (struct x_output) [HAVE_X_I18N]: Remove xic_base_fontname + member which is not really used any more. + (FRAME_XIC_BASE_FONTNAME): Remove. + * xfns.c (xic_free_fontset): Adjust user. + * xmenu.c (mouse_position_for_popup, x_activate_menubar) + (update_frame_menubar, set_frame_menubar, free_frame_menubar) + (create_and_show_popup_menu, xmenu_show, create_and_show_dialog) + (xdialog_show): Use eassert for debugging check. + 2013-08-01 Paul Eggert * fileio.c, fns.c (merge): Move extern decl from here ... === modified file 'src/xfns.c' --- src/xfns.c 2013-07-31 12:50:59 +0000 +++ src/xfns.c 2013-08-02 03:55:24 +0000 @@ -2088,9 +2088,6 @@ /* The fontset is not used anymore. It is safe to free it. */ XFreeFontSet (FRAME_X_DISPLAY (f), FRAME_XIC_FONTSET (f)); - if (FRAME_XIC_BASE_FONTNAME (f)) - xfree (FRAME_XIC_BASE_FONTNAME (f)); - FRAME_XIC_BASE_FONTNAME (f) = NULL; FRAME_XIC_FONTSET (f) = NULL; } === modified file 'src/xmenu.c' --- src/xmenu.c 2013-07-31 12:50:59 +0000 +++ src/xmenu.c 2013-08-02 03:55:24 +0000 @@ -159,8 +159,7 @@ Window root, dummy_window; int dummy; - if (! FRAME_X_P (f)) - emacs_abort (); + eassert (FRAME_X_P (f)); block_input (); @@ -623,8 +622,7 @@ void x_activate_menubar (FRAME_PTR f) { - if (! FRAME_X_P (f)) - emacs_abort (); + eassert (FRAME_X_P (f)); if (!f->output_data.x->saved_menu_event->type) return; @@ -839,8 +837,7 @@ struct x_output *x; int columns, rows; - if (! FRAME_X_P (f)) - emacs_abort (); + eassert (FRAME_X_P (f)); x = f->output_data.x; @@ -927,8 +924,7 @@ bool *submenu_top_level_items; int *submenu_n_panes; - if (! FRAME_X_P (f)) - emacs_abort (); + eassert (FRAME_X_P (f)); menubar_widget = f->output_data.x->menubar_widget; @@ -1286,8 +1282,7 @@ { Widget menubar_widget; - if (! FRAME_X_P (f)) - emacs_abort (); + eassert (FRAME_X_P (f)); menubar_widget = f->output_data.x->menubar_widget; @@ -1434,8 +1429,7 @@ use_pos_func = 1; #endif - if (! FRAME_X_P (f)) - emacs_abort (); + eassert (FRAME_X_P (f)); xg_crazy_callback_abort = 1; menu = xg_create_widget ("popup", first_wv->name, f, first_wv, @@ -1539,8 +1533,7 @@ LWLIB_ID menu_id; Widget menu; - if (! FRAME_X_P (f)) - emacs_abort (); + eassert (FRAME_X_P (f)); #ifdef USE_LUCID apply_systemfont_to_menu (f, f->output_data.x->widget); @@ -1623,8 +1616,7 @@ ptrdiff_t specpdl_count = SPECPDL_INDEX (); - if (! FRAME_X_P (f)) - emacs_abort (); + eassert (FRAME_X_P (f)); *error_name = NULL; @@ -1906,8 +1898,7 @@ { GtkWidget *menu; - if (! FRAME_X_P (f)) - emacs_abort (); + eassert (FRAME_X_P (f)); menu = xg_create_widget ("dialog", first_wv->name, f, first_wv, G_CALLBACK (dialog_selection_callback), @@ -1953,8 +1944,7 @@ { LWLIB_ID dialog_id; - if (!FRAME_X_P (f)) - emacs_abort (); + eassert (FRAME_X_P (f)); dialog_id = widget_id_tick++; #ifdef USE_LUCID @@ -2012,8 +2002,7 @@ ptrdiff_t specpdl_count = SPECPDL_INDEX (); - if (! FRAME_X_P (f)) - emacs_abort (); + eassert (FRAME_X_P (f)); *error_name = NULL; @@ -2269,8 +2258,7 @@ unsigned int dummy_uint; ptrdiff_t specpdl_count = SPECPDL_INDEX (); - if (! FRAME_X_P (f) && ! FRAME_MSDOS_P (f)) - emacs_abort (); + eassert (FRAME_X_P (f) || FRAME_MSDOS_P (f)); *error_name = 0; if (menu_items_n_panes == 0) === modified file 'src/xterm.h' --- src/xterm.h 2013-08-01 07:33:58 +0000 +++ src/xterm.h 2013-08-02 03:55:24 +0000 @@ -590,7 +590,6 @@ XIC xic; XIMStyle xic_style; XFontSet xic_xfs; - char *xic_base_fontname; #endif /* Relief GCs, colors etc. */ @@ -754,7 +753,6 @@ #define FRAME_X_XIM_STYLES(f) (FRAME_X_DISPLAY_INFO (f)->xim_styles) #define FRAME_XIC_STYLE(f) ((f)->output_data.x->xic_style) #define FRAME_XIC_FONTSET(f) ((f)->output_data.x->xic_xfs) -#define FRAME_XIC_BASE_FONTNAME(f) ((f)->output_data.x->xic_base_fontname) /* Value is the smallest width of any character in any font on frame F. */ ------------------------------------------------------------ revno: 113645 fixes bug: http://debbugs.gnu.org/15000 committer: Juanma Barranquero branch nick: trunk timestamp: Fri 2013-08-02 05:44:59 +0200 message: etc/tutorials/TUTORIAL.es: Fix typos (bug#15000). diff: === modified file 'etc/ChangeLog' --- etc/ChangeLog 2013-07-26 01:45:52 +0000 +++ etc/ChangeLog 2013-08-02 03:44:59 +0000 @@ -1,3 +1,7 @@ +2013-08-02 Juanma Barranquero + + * tutorials/TUTORIAL.es: Fix typos (bug#15000). + 2013-07-26 Micah Anderson (tiny change) * spook.lines: Additions. (Bug#14658) === modified file 'etc/tutorials/TUTORIAL.es' --- etc/tutorials/TUTORIAL.es 2013-03-12 01:14:08 +0000 +++ etc/tutorials/TUTORIAL.es 2013-08-02 03:44:59 +0000 @@ -285,7 +285,7 @@ queremos explicar cómo deshacerse de ventanas adicionales y volver a la edición básica en una ventana. Es sencillo: - C-x 1 Una ventana (p.ej., elimina todas las otras ventanas). + C-x 1 Una ventana (es decir, elimina todas las demás ventanas). Esto es CONTROL-x seguido por el dígito 1. C-x 1 expande la ventana que contiene el cursor, para ocupar toda la pantalla. Esto borra todas las @@ -374,7 +374,7 @@ Note que y C-d, comparados con M- y M-d, extienden el paralelismo iniciado por C-f y M-f (bien, no es realmente una tecla de control, pero no nos preocuparemos de eso ahora). C-k y M-k, -en ciertas forma, son como C-e y M-e, en que las líneas de unos +en cierta forma, son como C-e y M-e, en que las líneas de unos corresponden a sentencias en los otros. También puede eliminar un segmento contiguo de texto con un método ------------------------------------------------------------ revno: 113644 committer: Xue Fuqiao branch nick: trunk timestamp: Fri 2013-08-02 10:33:12 +0800 message: * doc/lispintro/emacs-lisp-intro.texi (zap-to-char): Remove obsolete stuff. diff: === modified file 'doc/lispintro/ChangeLog' --- doc/lispintro/ChangeLog 2013-07-06 01:39:21 +0000 +++ doc/lispintro/ChangeLog 2013-08-02 02:33:12 +0000 @@ -1,3 +1,7 @@ +2013-08-02 Xue Fuqiao + + * emacs-lisp-intro.texi (zap-to-char): Remove obsolete stuff. + 2013-07-06 Glenn Morris * emacs-lisp-intro.texi (Top): === modified file 'doc/lispintro/emacs-lisp-intro.texi' --- doc/lispintro/emacs-lisp-intro.texi 2013-07-06 01:39:21 +0000 +++ doc/lispintro/emacs-lisp-intro.texi 2013-08-02 02:33:12 +0000 @@ -7537,20 +7537,7 @@ @section @code{zap-to-char} @findex zap-to-char -@c FIXME remove obsolete stuff -The @code{zap-to-char} function changed little between GNU Emacs -version 19 and GNU Emacs version 22. However, @code{zap-to-char} -calls another function, @code{kill-region}, which enjoyed a major -rewrite. - -The @code{kill-region} function in Emacs 19 is complex, but does not -use code that is important at this time. We will skip it. - -The @code{kill-region} function in Emacs 22 is easier to read than the -same function in Emacs 19 and introduces a very important concept, -that of error handling. We will walk through the function. - -But first, let us look at the interactive @code{zap-to-char} function. +Let us look at the interactive @code{zap-to-char} function. @menu * Complete zap-to-char:: The complete implementation. ------------------------------------------------------------ revno: 113643 committer: Katsumi Yamaoka branch nick: trunk timestamp: Fri 2013-08-02 00:50:14 +0000 message: lisp/gnus/ChangeLog: Fix previous commit diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2013-08-01 22:58:40 +0000 +++ lisp/gnus/ChangeLog 2013-08-02 00:50:14 +0000 @@ -3,9 +3,6 @@ * message.el (message-ignored-news-headers): Delete X-Gnus-Delayed before sending. - * dgnushack.el (dgnushack-compile): Add a temporary check for - gnus-icalendar. - * mm-decode.el (mm-command-output): New face. (mm-display-external): Use it. ------------------------------------------------------------ revno: 113642 committer: Stefan Monnier branch nick: trunk timestamp: Thu 2013-08-01 19:18:37 -0400 message: * lisp/files.el: Use lexical-binding. (dir-locals-read-from-file): Remove unused `err' variable. (hack-dir-local-variables--warned-coding): New var. (hack-dir-local-variables): Use it to avoid repeated warnings. (make-backup-file-name--default-function): New function. (make-backup-file-name-function): Use it as default. (buffer-stale--default-function): New function. (buffer-stale-function): Use it as default. (revert-buffer-insert-file-contents--default-function): New function. (revert-buffer-insert-file-contents-function): Use it as default. (insert-directory): Avoid add-to-list. * lisp/autorevert.el (auto-revert-handler): Simplify. Use buffer-stale--default-function. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-08-01 22:53:03 +0000 +++ lisp/ChangeLog 2013-08-01 23:18:37 +0000 @@ -1,3 +1,20 @@ +2013-08-01 Stefan Monnier + + * files.el: Use lexical-binding. + (dir-locals-read-from-file): Remove unused `err' variable. + (hack-dir-local-variables--warned-coding): New var. + (hack-dir-local-variables): Use it to avoid repeated warnings. + (make-backup-file-name--default-function): New function. + (make-backup-file-name-function): Use it as default. + (buffer-stale--default-function): New function. + (buffer-stale-function): Use it as default. + (revert-buffer-insert-file-contents--default-function): New function. + (revert-buffer-insert-file-contents-function): Use it as default. + (insert-directory): Avoid add-to-list. + + * autorevert.el (auto-revert-handler): Simplify. + Use buffer-stale--default-function. + 2013-08-01 Tassilo Horn * speedbar.el (speedbar-query-confirmation-method): Doc fix. === modified file 'lisp/autorevert.el' --- lisp/autorevert.el 2013-07-24 13:29:15 +0000 +++ lisp/autorevert.el 2013-08-01 23:18:37 +0000 @@ -595,14 +595,14 @@ (setq size (nth 7 (file-attributes buffer-file-name))))) - (and (file-readable-p buffer-file-name) - (not (verify-visited-file-modtime buffer))))) + (funcall (or buffer-stale-function + #'buffer-stale--default-function) + t))) (and (or auto-revert-mode global-auto-revert-non-file-buffers) - revert-buffer-function - (boundp 'buffer-stale-function) - (functionp buffer-stale-function) - (funcall buffer-stale-function t)))) + (funcall (or buffer-stale-function + #'buffer-stale--default-function) + t)))) eob eoblist) (setq auto-revert-notify-modified-p nil) (when revert === modified file 'lisp/files.el' --- lisp/files.el 2013-07-31 06:52:26 +0000 +++ lisp/files.el 2013-08-01 23:18:37 +0000 @@ -1,4 +1,4 @@ -;;; files.el --- file input and output commands for Emacs +;;; files.el --- file input and output commands for Emacs -*- lexical-binding:t -*- ;; Copyright (C) 1985-1987, 1992-2013 Free Software Foundation, Inc. @@ -3645,20 +3645,19 @@ (with-temp-buffer ;; This is with-demoted-errors, but we want to mention dir-locals ;; in any error message. - (let (err) - (condition-case err - (progn - (insert-file-contents file) - (unless (zerop (buffer-size)) - (let* ((dir-name (file-name-directory file)) - (class-name (intern dir-name)) - (variables (let ((read-circle nil)) - (read (current-buffer))))) - (dir-locals-set-class-variables class-name variables) - (dir-locals-set-directory-class dir-name class-name - (nth 5 (file-attributes file))) - class-name))) - (error (message "Error reading dir-locals: %S" err) nil))))) + (condition-case err + (progn + (insert-file-contents file) + (unless (zerop (buffer-size)) + (let* ((dir-name (file-name-directory file)) + (class-name (intern dir-name)) + (variables (let ((read-circle nil)) + (read (current-buffer))))) + (dir-locals-set-class-variables class-name variables) + (dir-locals-set-directory-class dir-name class-name + (nth 5 (file-attributes file))) + class-name))) + (error (message "Error reading dir-locals: %S" err) nil)))) (defcustom enable-remote-dir-locals nil "Non-nil means dir-local variables will be applied to remote files." @@ -3666,6 +3665,8 @@ :type 'boolean :group 'find-file) +(defvar hack-dir-local-variables--warned-coding nil) + (defun hack-dir-local-variables () "Read per-directory local variables for the current buffer. Store the directory-local variables in `dir-local-variables-alist' @@ -3697,8 +3698,10 @@ (when variables (dolist (elt variables) (if (eq (car elt) 'coding) - (display-warning :warning - "Coding cannot be specified by dir-locals") + (unless hack-dir-local-variables--warned-coding + (setq hack-dir-local-variables--warned-coding t) + (display-warning :warning + "Coding cannot be specified by dir-locals")) (unless (memq (car elt) '(eval mode)) (setq dir-local-variables-alist (assq-delete-all (car elt) dir-local-variables-alist))) @@ -4145,9 +4148,9 @@ (file-name-sans-extension (file-name-nondirectory (or filename (buffer-file-name))))) -(defcustom make-backup-file-name-function nil +(defcustom make-backup-file-name-function + #'make-backup-file-name--default-function "A function to use instead of the default `make-backup-file-name'. -A value of nil gives the default `make-backup-file-name' behavior. This could be buffer-local to do something special for specific files. If you define it, you may need to change `backup-file-name-p' @@ -4155,8 +4158,7 @@ See also `backup-directory-alist'." :group 'backup - :type '(choice (const :tag "Default" nil) - (function :tag "Your function"))) + :type '(function :tag "Your function")) (defcustom backup-directory-alist nil "Alist of filename patterns and backup directory names. @@ -4216,24 +4218,26 @@ Normally this will just be the file's name with `~' appended. Customization hooks are provided as follows. -If the variable `make-backup-file-name-function' is non-nil, its value -should be a function which will be called with FILE as its argument; -the resulting name is used. +The value of `make-backup-file-name-function' should be a function which +will be called with FILE as its argument; the resulting name is used. -Otherwise a match for FILE is sought in `backup-directory-alist'; see +By default, a match for FILE is sought in `backup-directory-alist'; see the documentation of that variable. If the directory for the backup doesn't exist, it is created." - (if make-backup-file-name-function - (funcall make-backup-file-name-function file) - (if (and (eq system-type 'ms-dos) - (not (msdos-long-file-names))) - (let ((fn (file-name-nondirectory file))) - (concat (file-name-directory file) - (or (and (string-match "\\`[^.]+\\'" fn) - (concat (match-string 0 fn) ".~")) - (and (string-match "\\`[^.]+\\.\\(..?\\)?" fn) - (concat (match-string 0 fn) "~"))))) - (concat (make-backup-file-name-1 file) "~")))) + (funcall (or make-backup-file-name-function + #'make-backup-file-name--default-function) + file)) + +(defun make-backup-file-name--default-function (file) + (if (and (eq system-type 'ms-dos) + (not (msdos-long-file-names))) + (let ((fn (file-name-nondirectory file))) + (concat (file-name-directory file) + (or (and (string-match "\\`[^.]+\\'" fn) + (concat (match-string 0 fn) ".~")) + (and (string-match "\\`[^.]+\\.\\(..?\\)?" fn) + (concat (match-string 0 fn) "~"))))) + (concat (make-backup-file-name-1 file) "~"))) (defun make-backup-file-name-1 (file) "Subroutine of `make-backup-file-name' and `find-backup-file-name'." @@ -5254,14 +5258,20 @@ via the `revert-buffer-preserve-modes' dynamic variable.") (put 'revert-buffer-insert-file-contents-function 'permanent-local t) -(defvar revert-buffer-insert-file-contents-function nil +(defvar revert-buffer-insert-file-contents-function + #'revert-buffer-insert-file-contents--default-function "Function to use to insert contents when reverting this buffer. Gets two args, first the nominal file name to use, and second, t if reading the auto-save file. The function you specify is responsible for updating (or preserving) point.") -(defvar buffer-stale-function nil +(defun buffer-stale--default-function (&optional _noconfirm) + (and buffer-file-name + (file-readable-p buffer-file-name) + (not (verify-visited-file-modtime (current-buffer))))) + +(defvar buffer-stale-function #'buffer-stale--default-function "Function to check whether a non-file buffer needs reverting. This should be a function with one optional argument NOCONFIRM. Auto Revert Mode passes t for NOCONFIRM. The function should return @@ -5382,62 +5392,11 @@ (local-hook (when (local-variable-p 'after-revert-hook) after-revert-hook)) (inhibit-read-only t)) - (cond - (revert-buffer-insert-file-contents-function - (unless (eq buffer-undo-list t) - ;; Get rid of all undo records for this buffer. - (setq buffer-undo-list nil)) - ;; Don't make undo records for the reversion. - (let ((buffer-undo-list t)) - (funcall revert-buffer-insert-file-contents-function - file-name auto-save-p))) - ((not (file-exists-p file-name)) - (error (if buffer-file-number - "File %s no longer exists!" - "Cannot revert nonexistent file %s") - file-name)) - ((not (file-readable-p file-name)) - (error (if buffer-file-number - "File %s no longer readable!" - "Cannot revert unreadable file %s") - file-name)) - (t - ;; Bind buffer-file-name to nil - ;; so that we don't try to lock the file. - (let ((buffer-file-name nil)) - (or auto-save-p - (unlock-buffer))) - (widen) - (let ((coding-system-for-read - ;; Auto-saved file should be read by Emacs's - ;; internal coding. - (if auto-save-p 'auto-save-coding - (or coding-system-for-read - (and - buffer-file-coding-system-explicit - (car buffer-file-coding-system-explicit)))))) - (if (and (not enable-multibyte-characters) - coding-system-for-read - (not (memq (coding-system-base - coding-system-for-read) - '(no-conversion raw-text)))) - ;; As a coding system suitable for multibyte - ;; buffer is specified, make the current - ;; buffer multibyte. - (set-buffer-multibyte t)) - - ;; This force after-insert-file-set-coding - ;; (called from insert-file-contents) to set - ;; buffer-file-coding-system to a proper value. - (kill-local-variable 'buffer-file-coding-system) - - ;; Note that this preserves point in an intelligent way. - (if revert-buffer-preserve-modes - (let ((buffer-file-format buffer-file-format)) - (insert-file-contents file-name (not auto-save-p) - nil nil t)) - (insert-file-contents file-name (not auto-save-p) - nil nil t))))) + ;; FIXME: Throw away undo-log when preserve-modes is nil? + (funcall + (or revert-buffer-insert-file-contents-function + #'revert-buffer-insert-file-contents--default-function) + file-name auto-save-p) ;; Recompute the truename in case changes in symlinks ;; have changed the truename. (setq buffer-file-truename @@ -5452,6 +5411,56 @@ (run-hooks 'revert-buffer-internal-hook)) t))))) +(defun revert-buffer-insert-file-contents--default-function (file-name auto-save-p) + (cond + ((not (file-exists-p file-name)) + (error (if buffer-file-number + "File %s no longer exists!" + "Cannot revert nonexistent file %s") + file-name)) + ((not (file-readable-p file-name)) + (error (if buffer-file-number + "File %s no longer readable!" + "Cannot revert unreadable file %s") + file-name)) + (t + ;; Bind buffer-file-name to nil + ;; so that we don't try to lock the file. + (let ((buffer-file-name nil)) + (or auto-save-p + (unlock-buffer))) + (widen) + (let ((coding-system-for-read + ;; Auto-saved file should be read by Emacs's + ;; internal coding. + (if auto-save-p 'auto-save-coding + (or coding-system-for-read + (and + buffer-file-coding-system-explicit + (car buffer-file-coding-system-explicit)))))) + (if (and (not enable-multibyte-characters) + coding-system-for-read + (not (memq (coding-system-base + coding-system-for-read) + '(no-conversion raw-text)))) + ;; As a coding system suitable for multibyte + ;; buffer is specified, make the current + ;; buffer multibyte. + (set-buffer-multibyte t)) + + ;; This force after-insert-file-set-coding + ;; (called from insert-file-contents) to set + ;; buffer-file-coding-system to a proper value. + (kill-local-variable 'buffer-file-coding-system) + + ;; Note that this preserves point in an intelligent way. + (if revert-buffer-preserve-modes + (let ((buffer-file-format buffer-file-format)) + (insert-file-contents file-name (not auto-save-p) + nil nil t)) + (insert-file-contents file-name (not auto-save-p) + nil nil t)))))) + (defun recover-this-file () "Recover the visited file--get contents from its last auto-save file." (interactive) @@ -6204,9 +6213,10 @@ ;; directory if FILE is a symbolic link. (unless full-directory-p (setq switches - (if (stringp switches) - (concat switches " -d") - (add-to-list 'switches "-d" 'append)))) + (cond + ((stringp switches) (concat switches " -d")) + ((member "-d" switches) switches) + (t (append switches '("-d")))))) (apply 'call-process insert-directory-program nil t nil (append ------------------------------------------------------------ revno: 113641 committer: Glenn Morris branch nick: trunk timestamp: Thu 2013-08-01 19:10:51 -0400 message: * test/automated/file-notify-tests.el (file-notify--test-remote-enabled): Try to check that the remote system has a notification program. diff: === modified file 'test/ChangeLog' --- test/ChangeLog 2013-07-31 07:08:47 +0000 +++ test/ChangeLog 2013-08-01 23:10:51 +0000 @@ -1,3 +1,8 @@ +2013-08-01 Glenn Morris + + * automated/file-notify-tests.el (file-notify--test-remote-enabled): + Try to check that the remote system has a notification program. + 2013-07-31 Glenn Morris * automated/undo-tests.el (undo-test2, undo-test5): Be quieter. === modified file 'test/automated/file-notify-tests.el' --- test/automated/file-notify-tests.el 2013-07-24 13:56:19 +0000 +++ test/automated/file-notify-tests.el 2013-08-01 23:10:51 +0000 @@ -43,6 +43,7 @@ (defvar file-notify--test-event nil) (require 'tramp) +(require 'tramp-sh) (setq tramp-verbose 0 tramp-message-show-message nil) (when noninteractive (defalias 'tramp-read-passwd 'ignore)) @@ -57,7 +58,18 @@ (ignore-errors (and (file-remote-p file-notify-test-remote-temporary-file-directory) (file-directory-p file-notify-test-remote-temporary-file-directory) - (file-writable-p file-notify-test-remote-temporary-file-directory)))) + (file-writable-p file-notify-test-remote-temporary-file-directory) + ;; Extracted from tramp-sh-handle-file-notify-add-watch. + ;; Even though the "remote" system is just ssh@localhost, + ;; the PATH might not be the same as the "local" PATH. + ;; Eg this seems to be the case on hydra.nixos.org. + ;; Without this, tests fail with: + ;; "No file notification program found on /ssh:localhost:" + ;; Try to fix PATH instead? + (with-parsed-tramp-file-name + file-notify-test-remote-temporary-file-directory nil + (or (tramp-get-remote-gvfs-monitor-dir v) + (tramp-get-remote-inotifywait v)))))) (defmacro file-notify--deftest-remote (test docstring) "Define ert `TEST-remote' for remote files." ------------------------------------------------------------ revno: 113640 author: Gnus developers committer: Katsumi Yamaoka branch nick: trunk timestamp: Thu 2013-08-01 22:58:40 +0000 message: Merge changes made in Gnus master 2013-08-01 Lars Magne Ingebrigtsen * gnus.texi (Basic Usage): Mention that warp means jump here. (The notmuch Engine): Mention notmuch. 2013-08-01 Lars Magne Ingebrigtsen * message.el (message-ignored-news-headers): Delete X-Gnus-Delayed before sending. * dgnushack.el (dgnushack-compile): Add a temporary check for gnus-icalendar. * mm-decode.el (mm-command-output): New face. (mm-display-external): Use it. 2013-08-01 Kan-Ru Chen (陳侃如) (tiny change) * nnmbox.el (nnmbox-request-article): Don't change point. 2013-08-01 Lars Magne Ingebrigtsen * gnus-icalendar.el (gnus-icalendar-event:inline-reply-buttons): Include `handle' parameter. 2013-08-01 Jan Tatarik * gnus-icalendar.el: New file. 2013-08-01 Lars Magne Ingebrigtsen * gnus-int.el (gnus-warp-to-article): Mention that warp means jump. * gnus-uu.el (gnus-uu-mark-thread, gnus-uu-unmark-thread): Work with dummy roots, too. 2013-08-01 David Edmondson * mml2015.el (mml2015-epg-key-image-to-string): Protect against bugging out on ttys. 2013-08-01 Lars Magne Ingebrigtsen * gnus-start.el (gnus-dribble-save): Only save the dribble file if it's not empty. diff: === modified file 'doc/misc/ChangeLog' --- doc/misc/ChangeLog 2013-07-30 08:16:20 +0000 +++ doc/misc/ChangeLog 2013-08-01 22:58:40 +0000 @@ -1,3 +1,8 @@ +2013-08-01 Lars Magne Ingebrigtsen + + * gnus.texi (Basic Usage): Mention that warp means jump here. + (The notmuch Engine): Mention notmuch. + 2013-07-30 Tassilo Horn * gnus.texi (Sorting the Summary Buffer): Document new defcustom === modified file 'doc/misc/gnus.texi' --- doc/misc/gnus.texi 2013-07-30 08:16:20 +0000 +++ doc/misc/gnus.texi 2013-08-01 22:58:40 +0000 @@ -21109,17 +21109,17 @@ showing these articles. Articles may then be read, moved and deleted using the usual commands. -The @code{nnir} group made in this way is an @code{ephemeral} group, and -some changes are not permanent: aside from reading, moving, and +The @code{nnir} group made in this way is an @code{ephemeral} group, +and some changes are not permanent: aside from reading, moving, and deleting, you can't act on the original article. But there is an -alternative: you can @emph{warp} to the original group for the article -on the current line with @kbd{A W}, aka +alternative: you can @emph{warp} (i.e., jump) to the original group +for the article on the current line with @kbd{A W}, aka @code{gnus-warp-to-article}. Even better, the function -@code{gnus-summary-refer-thread}, bound by default in summary buffers to -@kbd{A T}, will first warp to the original group before it works its -magic and includes all the articles in the thread. From here you can -read, move and delete articles, but also copy them, alter article marks, -whatever. Go nuts. +@code{gnus-summary-refer-thread}, bound by default in summary buffers +to @kbd{A T}, will first warp to the original group before it works +its magic and includes all the articles in the thread. From here you +can read, move and delete articles, but also copy them, alter article +marks, whatever. Go nuts. You say you want to search more than just the group on the current line? No problem: just process-mark the groups you want to search. You want @@ -21161,6 +21161,7 @@ * The swish++ Engine:: Swish++ configuration and usage. * The swish-e Engine:: Swish-e configuration and usage. * The namazu Engine:: Namazu configuration and usage. +* The notmuch Engine:: Notmuch configuration and usage. * The hyrex Engine:: Hyrex configuration and usage. * Customizations:: User customizable settings. @end menu @@ -21390,6 +21391,26 @@ For maximum searching efficiency you might want to have a cron job run this command periodically, say every four hours. + +@node The notmuch Engine +@subsubsection The notmuch Engine + +@table @code +@item nnir-notmuch-program +The name of the notmuch search executable. Defaults to +@samp{notmuch}. + +@item nnir-notmuch-additional-switches +A list of strings, to be given as additional arguments to notmuch. + +@item nnir-notmuch-remove-prefix +The prefix to remove from each file name returned by notmuch in order +to get a group name (albeit with @samp{/} instead of @samp{.}). This +is a regular expression. + +@end table + + @node The hyrex Engine @subsubsection The hyrex Engine This engine is obsolete. === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2013-08-01 11:23:38 +0000 +++ lisp/gnus/ChangeLog 2013-08-01 22:58:40 +0000 @@ -1,5 +1,44 @@ 2013-08-01 Lars Magne Ingebrigtsen + * message.el (message-ignored-news-headers): Delete X-Gnus-Delayed + before sending. + + * dgnushack.el (dgnushack-compile): Add a temporary check for + gnus-icalendar. + + * mm-decode.el (mm-command-output): New face. + (mm-display-external): Use it. + +2013-08-01 Kan-Ru Chen (陳侃如) (tiny change) + + * nnmbox.el (nnmbox-request-article): Don't change point. + +2013-08-01 Lars Magne Ingebrigtsen + + * gnus-icalendar.el (gnus-icalendar-event:inline-reply-buttons): + Include `handle' parameter. + +2013-08-01 Jan Tatarik + + * gnus-icalendar.el: New file. + +2013-08-01 Lars Magne Ingebrigtsen + + * gnus-int.el (gnus-warp-to-article): Mention that warp means jump. + + * gnus-uu.el (gnus-uu-mark-thread, gnus-uu-unmark-thread): Work with + dummy roots, too. + +2013-08-01 David Edmondson + + * mml2015.el (mml2015-epg-key-image-to-string): Protect against bugging + out on ttys. + +2013-08-01 Lars Magne Ingebrigtsen + + * gnus-start.el (gnus-dribble-save): Only save the dribble file if it's + not empty. + * nnrss.el (nnrss-discover-feed): Indent. 2013-08-01 Katsumi Yamaoka === added file 'lisp/gnus/gnus-icalendar.el' --- lisp/gnus/gnus-icalendar.el 1970-01-01 00:00:00 +0000 +++ lisp/gnus/gnus-icalendar.el 2013-08-01 22:58:40 +0000 @@ -0,0 +1,837 @@ +;;; gnus-icalendar.el --- reply to iCalendar meeting requests + +;; Copyright (C) 2013 Free Software Foundation, Inc. + +;; Author: Jan Tatarik +;; Keywords: mail, icalendar, org + +;; 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 3 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, see . + +;;; Commentary: + +;; To install: +;; (require 'gnus-icalendar) +;; (gnus-icalendar-setup) + +;; to enable optional iCalendar->Org sync functionality +;; NOTE: both the capture file and the headline(s) inside must already exist +;; (setq gnus-icalendar-org-capture-file "~/org/notes.org") +;; (setq gnus-icalendar-org-capture-headline '("Calendar")) +;; (gnus-icalendar-org-setup) + + +;;; Code: + +(require 'icalendar) +(require 'eieio) +(require 'mm-decode) +(require 'gnus-sum) + +(eval-when-compile (require 'cl)) + +(defun gnus-icalendar-find-if (pred seq) + (catch 'found + (while seq + (when (funcall pred (car seq)) + (throw 'found (car seq))) + (pop seq)))) + +;;; +;;; ical-event +;;; + +(defclass gnus-icalendar-event () + ((organizer :initarg :organizer + :accessor gnus-icalendar-event:organizer + :initform "" + :type (or null string)) + (summary :initarg :summary + :accessor gnus-icalendar-event:summary + :initform "" + :type (or null string)) + (description :initarg :description + :accessor gnus-icalendar-event:description + :initform "" + :type (or null string)) + (location :initarg :location + :accessor gnus-icalendar-event:location + :initform "" + :type (or null string)) + (start :initarg :start + :accessor gnus-icalendar-event:start + :initform "" + :type (or null string)) + (end :initarg :end + :accessor gnus-icalendar-event:end + :initform "" + :type (or null string)) + (recur :initarg :recur + :accessor gnus-icalendar-event:recur + :initform "" + :type (or null string)) + (uid :initarg :uid + :accessor gnus-icalendar-event:uid + :type string) + (method :initarg :method + :accessor gnus-icalendar-event:method + :initform "PUBLISH" + :type (or null string)) + (rsvp :initarg :rsvp + :accessor gnus-icalendar-event:rsvp + :initform nil + :type (or null boolean))) + "generic iCalendar Event class") + +(defclass gnus-icalendar-event-request (gnus-icalendar-event) + nil + "iCalendar class for REQUEST events") + +(defclass gnus-icalendar-event-cancel (gnus-icalendar-event) + nil + "iCalendar class for CANCEL events") + +(defclass gnus-icalendar-event-reply (gnus-icalendar-event) + nil + "iCalendar class for REPLY events") + +(defmethod gnus-icalendar-event:recurring-p ((event gnus-icalendar-event)) + "Return t if EVENT is recurring." + (not (null (gnus-icalendar-event:recur event)))) + +(defmethod gnus-icalendar-event:recurring-freq ((event gnus-icalendar-event)) + "Return recurring frequency of EVENT." + (let ((rrule (gnus-icalendar-event:recur event))) + (string-match "FREQ=\\([[:alpha:]]+\\)" rrule) + (match-string 1 rrule))) + +(defmethod gnus-icalendar-event:recurring-interval ((event gnus-icalendar-event)) + "Return recurring interval of EVENT." + (let ((rrule (gnus-icalendar-event:recur event)) + (default-interval 1)) + + (string-match "INTERVAL=\\([[:digit:]]+\\)" rrule) + (or (match-string 1 rrule) + default-interval))) + +(defmethod gnus-icalendar-event:start-time ((event gnus-icalendar-event)) + "Return time value of the EVENT start date." + (date-to-time (gnus-icalendar-event:start event))) + +(defmethod gnus-icalendar-event:end-time ((event gnus-icalendar-event)) + "Return time value of the EVENT end date." + (date-to-time (gnus-icalendar-event:end event))) + + +(defun gnus-icalendar-event--decode-datefield (ical field zone-map &optional date-style) + (let* ((calendar-date-style (or date-style 'european)) + (date (icalendar--get-event-property ical field)) + (date-zone (icalendar--find-time-zone + (icalendar--get-event-property-attributes + ical field) + zone-map)) + (date-decoded (icalendar--decode-isodatetime date nil date-zone))) + + (concat (icalendar--datetime-to-iso-date date-decoded "-") + " " + (icalendar--datetime-to-colontime date-decoded)))) + +(defun gnus-icalendar-event--find-attendee (ical name-or-email) + (let* ((event (car (icalendar--all-events ical))) + (event-props (caddr event))) + (labels ((attendee-name (att) (plist-get (cadr att) 'CN)) + (attendee-email (att) + (replace-regexp-in-string "^.*MAILTO:" "" (caddr att))) + (attendee-prop-matches-p (prop) + (and (eq (car prop) 'ATTENDEE) + (or (member (attendee-name prop) name-or-email) + (let ((att-email (attendee-email prop))) + (gnus-icalendar-find-if (lambda (email) + (string-match email att-email)) + name-or-email)))))) + + (gnus-icalendar-find-if #'attendee-prop-matches-p event-props)))) + + +(defun gnus-icalendar-event-from-ical (ical &optional attendee-name-or-email) + (let* ((event (car (icalendar--all-events ical))) + (zone-map (icalendar--convert-all-timezones ical)) + (organizer (replace-regexp-in-string + "^.*MAILTO:" "" + (or (icalendar--get-event-property event 'ORGANIZER) ""))) + (prop-map '((summary . SUMMARY) + (description . DESCRIPTION) + (location . LOCATION) + (recur . RRULE) + (uid . UID))) + (method (caddr (assoc 'METHOD (caddr (car (nreverse ical)))))) + (attendee (when attendee-name-or-email + (gnus-icalendar-event--find-attendee ical attendee-name-or-email))) + (args (list :method method + :organizer organizer + :start (gnus-icalendar-event--decode-datefield event 'DTSTART zone-map) + :end (gnus-icalendar-event--decode-datefield event 'DTEND zone-map) + :rsvp (string= (plist-get (cadr attendee) 'RSVP) + "TRUE"))) + (event-class (pcase method + ("REQUEST" 'gnus-icalendar-event-request) + ("CANCEL" 'gnus-icalendar-event-cancel) + ("REPLY" 'gnus-icalendar-event-reply) + (_ 'gnus-icalendar-event)))) + + (labels ((map-property (prop) + (let ((value (icalendar--get-event-property event prop))) + (when value + ;; ugly, but cannot get + ;;replace-regexp-in-string work with "\\" as + ;;REP, plus we should also handle "\\;" + (replace-regexp-in-string + "\\\\," "," + (replace-regexp-in-string + "\\\\n" "\n" (substring-no-properties value)))))) + (accumulate-args (mapping) + (destructuring-bind (slot . ical-property) mapping + (setq args (append (list + (intern (concat ":" (symbol-name slot))) + (map-property ical-property)) + args))))) + + (mapc #'accumulate-args prop-map) + (apply 'make-instance event-class args)))) + +(defun gnus-icalendar-event-from-buffer (buf &optional attendee-name-or-email) + "Parse RFC5545 iCalendar in buffer BUF and return an event object. + +Return a gnus-icalendar-event object representing the first event +contained in the invitation. Return nil for calendars without an event entry. + +ATTENDEE-NAME-OR-EMAIL is a list of strings that will be matched +against the event's attendee names and emails. Invitation rsvp +status will be retrieved from the first matching attendee record." + (let ((ical (with-current-buffer (icalendar--get-unfolded-buffer (get-buffer buf)) + (goto-char (point-min)) + (icalendar--read-element nil nil)))) + + (when ical + (gnus-icalendar-event-from-ical ical attendee-name-or-email)))) + +;;; +;;; gnus-icalendar-event-reply +;;; + +(defun gnus-icalendar-event--build-reply-event-body (ical-request status identities) + (let ((summary-status (capitalize (symbol-name status))) + (attendee-status (upcase (symbol-name status))) + reply-event-lines) + (labels ((update-summary (line) + (if (string-match "^[^:]+:" line) + (replace-match (format "\\&%s: " summary-status) t nil line) + line)) + (update-dtstamp () + (format-time-string "DTSTAMP:%Y%m%dT%H%M%SZ" nil t)) + (attendee-matches-identity (line) + (gnus-icalendar-find-if (lambda (name) (string-match-p name line)) + identities)) + (update-attendee-status (line) + (when (and (attendee-matches-identity line) + (string-match "\\(PARTSTAT=\\)[^;]+" line)) + (replace-match (format "\\1%s" attendee-status) t nil line))) + (process-event-line (line) + (when (string-match "^\\([^;:]+\\)" line) + (let* ((key (match-string 0 line)) + ;; NOTE: not all of the below fields are mandatory, + ;; but they are often present in other clients' + ;; replies. Can be helpful for debugging, too. + (new-line (pcase key + ("ATTENDEE" (update-attendee-status line)) + ("SUMMARY" (update-summary line)) + ("DTSTAMP" (update-dtstamp)) + ((or "ORGANIZER" "DTSTART" "DTEND" + "LOCATION" "DURATION" "SEQUENCE" + "RECURRENCE-ID" "UID") line) + (_ nil)))) + (when new-line + (push new-line reply-event-lines)))))) + + (mapc #'process-event-line (split-string ical-request "\n")) + + (unless (gnus-icalendar-find-if (lambda (x) (string-match "^ATTENDEE" x)) + reply-event-lines) + (error "Could not find an event attendee matching given identity")) + + (mapconcat #'identity `("BEGIN:VEVENT" + ,@(nreverse reply-event-lines) + "END:VEVENT") + "\n")))) + +(defun gnus-icalendar-event-reply-from-buffer (buf status identities) + "Build a calendar event reply for request contained in BUF. +The reply will have STATUS (`accepted', `tentative' or `declined'). +The reply will be composed for attendees matching any entry +on the IDENTITIES list." + (flet ((extract-block (blockname) + (save-excursion + (let ((block-start-re (format "^BEGIN:%s" blockname)) + (block-end-re (format "^END:%s" blockname)) + start) + (when (re-search-forward block-start-re nil t) + (setq start (line-beginning-position)) + (re-search-forward block-end-re) + (buffer-substring-no-properties start (line-end-position))))))) + + (let (zone event) + (with-current-buffer (icalendar--get-unfolded-buffer (get-buffer buf)) + (goto-char (point-min)) + (setq zone (extract-block "VTIMEZONE") + event (extract-block "VEVENT"))) + + (when event + (let ((contents (list "BEGIN:VCALENDAR" + "METHOD:REPLY" + "PRODID:Gnus" + "VERSION:2.0" + zone + (gnus-icalendar-event--build-reply-event-body event status identities) + "END:VCALENDAR"))) + + (mapconcat #'identity (delq nil contents) "\n")))))) + +;;; +;;; gnus-icalendar-org +;;; +;;; TODO: this is an optional feature, and it's only available with org-mode +;;; 7+, so will need to properly handle emacsen with no/outdated org-mode + +(require 'org) +(require 'org-capture) + +(defgroup gnus-icalendar-org nil + "Settings for Calendar Event gnus/org integration." + :group 'gnus-icalendar + :prefix "gnus-icalendar-org-") + +(defcustom gnus-icalendar-org-capture-file nil + "Target Org file for storing captured calendar events." + :type 'file + :group 'gnus-icalendar-org) + +(defcustom gnus-icalendar-org-capture-headline nil + "Target outline in `gnus-icalendar-org-capture-file' for storing captured events." + :type '(repeat string) + :group 'gnus-icalendar-org) + +(defcustom gnus-icalendar-org-template-name "used by gnus-icalendar-org" + "Org-mode template name." + :type '(string) + :group 'gnus-icalendar-org) + +(defcustom gnus-icalendar-org-template-key "#" + "Org-mode template hotkey." + :type '(string) + :group 'gnus-icalendar-org) + +(defvar gnus-icalendar-org-enabled-p nil) + + +(defmethod gnus-icalendar-event:org-repeat ((event gnus-icalendar-event)) + "Return `org-mode' timestamp repeater string for recurring EVENT. +Return nil for non-recurring EVENT." + (when (gnus-icalendar-event:recurring-p event) + (let* ((freq-map '(("HOURLY" . "h") + ("DAILY" . "d") + ("WEEKLY" . "w") + ("MONTHLY" . "m") + ("YEARLY" . "y"))) + (org-freq (cdr (assoc (gnus-icalendar-event:recurring-freq event) freq-map)))) + + (when org-freq + (format "+%s%s" (gnus-icalendar-event:recurring-interval event) org-freq))))) + +(defmethod gnus-icalendar-event:org-timestamp ((event gnus-icalendar-event)) + "Build `org-mode' timestamp from EVENT start/end dates and recurrence info." + (let* ((start (gnus-icalendar-event:start-time event)) + (end (gnus-icalendar-event:end-time event)) + (start-date (format-time-string "%Y-%m-%d %a" start t)) + (start-time (format-time-string "%H:%M" start t)) + (end-date (format-time-string "%Y-%m-%d %a" end t)) + (end-time (format-time-string "%H:%M" end t)) + (org-repeat (gnus-icalendar-event:org-repeat event)) + (repeat (if org-repeat (concat " " org-repeat) ""))) + + (if (equal start-date end-date) + (format "<%s %s-%s%s>" start-date start-time end-time repeat) + (format "<%s %s>--<%s %s>" start-date start-time end-date end-time)))) + +;; TODO: make the template customizable +(defmethod gnus-icalendar-event->org-entry ((event gnus-icalendar-event) reply-status) + "Return string with new `org-mode' entry describing EVENT." + (with-temp-buffer + (org-mode) + (with-slots (organizer summary description location + recur uid) event + (let* ((reply (if reply-status (capitalize (symbol-name reply-status)) + "Not replied yet")) + (props `(("ICAL_EVENT" . "t") + ("ID" . ,uid) + ("DT" . ,(gnus-icalendar-event:org-timestamp event)) + ("ORGANIZER" . ,(gnus-icalendar-event:organizer event)) + ("LOCATION" . ,(gnus-icalendar-event:location event)) + ("RRULE" . ,(gnus-icalendar-event:recur event)) + ("REPLY" . ,reply)))) + + (insert (format "* %s (%s)\n\n" summary location)) + (mapc (lambda (prop) + (org-entry-put (point) (car prop) (cdr prop))) + props)) + + (when description + (save-restriction + (narrow-to-region (point) (point)) + (insert description) + (indent-region (point-min) (point-max) 2) + (fill-region (point-min) (point-max)))) + + (buffer-string)))) + +(defun gnus-icalendar--deactivate-org-timestamp (ts) + (replace-regexp-in-string "[<>]" + (lambda (m) (pcase m ("<" "[") (">" "]"))) + ts)) + +(defun gnus-icalendar-find-org-event-file (event &optional org-file) + "Return the name of the file containing EVENT org entry. +Return nil when not found. + +All org agenda files are searched for the EVENT entry. When +the optional ORG-FILE argument is specified, only that one file +is searched." + (let ((uid (gnus-icalendar-event:uid event)) + (files (or org-file (org-agenda-files t 'ifmode)))) + (flet + ((find-event-in (file) + (org-check-agenda-file file) + (with-current-buffer (find-file-noselect file) + (let ((event-pos (org-find-entry-with-id uid))) + (when (and event-pos + (string= (cdr (assoc "ICAL_EVENT" (org-entry-properties event-pos))) + "t")) + (throw 'found file)))))) + + (gnus-icalendar-find-if #'find-event-in files)))) + + +(defun gnus-icalendar--show-org-event (event &optional org-file) + (let ((file (gnus-icalendar-find-org-event-file event org-file))) + (when file + (switch-to-buffer (find-file file)) + (goto-char (org-find-entry-with-id (gnus-icalendar-event:uid event))) + (org-show-entry)))) + + +(defun gnus-icalendar--update-org-event (event reply-status &optional org-file) + (let ((file (gnus-icalendar-find-org-event-file event org-file))) + (when file + (with-current-buffer (find-file-noselect file) + (with-slots (uid summary description organizer location recur) event + (let ((event-pos (org-find-entry-with-id uid))) + (when event-pos + (goto-char event-pos) + + ;; update the headline, keep todo, priority and tags, if any + (save-excursion + (let* ((priority (org-entry-get (point) "PRIORITY")) + (headline (delq nil (list + (org-entry-get (point) "TODO") + (when priority (format "[#%s]" priority)) + (format "%s (%s)" summary location) + (org-entry-get (point) "TAGS"))))) + + (re-search-forward "^\\*+ " (line-end-position)) + (delete-region (point) (line-end-position)) + (insert (mapconcat #'identity headline " ")))) + + ;; update props and description + (let ((entry-end (org-entry-end-position)) + (entry-outline-level (org-outline-level))) + + ;; delete body of the entry, leave org drawers intact + (save-restriction + (org-narrow-to-element) + (goto-char entry-end) + (re-search-backward "^[\t ]*:END:") + (forward-line) + (delete-region (point) entry-end)) + + ;; put new event description in the entry body + (when description + (save-restriction + (narrow-to-region (point) (point)) + (insert "\n" (replace-regexp-in-string "[\n]+$" "\n" description) "\n") + (indent-region (point-min) (point-max) (1+ entry-outline-level)) + (fill-region (point-min) (point-max)))) + + ;; update entry properties + (org-entry-put event-pos "DT" (gnus-icalendar-event:org-timestamp event)) + (org-entry-put event-pos "ORGANIZER" organizer) + (org-entry-put event-pos "LOCATION" location) + (org-entry-put event-pos "RRULE" recur) + (when reply-status (org-entry-put event-pos "REPLY" + (capitalize (symbol-name reply-status)))) + (save-buffer))))))))) + + +(defun gnus-icalendar--cancel-org-event (event &optional org-file) + (let ((file (gnus-icalendar-find-org-event-file event org-file))) + (when file + (with-current-buffer (find-file-noselect file) + (let ((event-pos (org-find-entry-with-id (gnus-icalendar-event:uid event)))) + (when event-pos + (let ((ts (org-entry-get event-pos "DT"))) + (when ts + (org-entry-put event-pos "DT" (gnus-icalendar--deactivate-org-timestamp ts)) + (save-buffer))))))))) + + +(defun gnus-icalendar--get-org-event-reply-status (event &optional org-file) + (let ((file (gnus-icalendar-find-org-event-file event org-file))) + (when file + (save-excursion + (with-current-buffer (find-file-noselect file) + (let ((event-pos (org-find-entry-with-id (gnus-icalendar-event:uid event)))) + (org-entry-get event-pos "REPLY"))))))) + + +(defun gnus-icalendar-insinuate-org-templates () + (unless (gnus-icalendar-find-if (lambda (x) (string= (cadr x) gnus-icalendar-org-template-name)) + org-capture-templates) + (setq org-capture-templates + (append `((,gnus-icalendar-org-template-key + ,gnus-icalendar-org-template-name + entry + (file+olp ,gnus-icalendar-org-capture-file ,@gnus-icalendar-org-capture-headline) + "%i" + :immediate-finish t)) + org-capture-templates)) + + ;; hide the template from interactive template selection list + ;; (org-capture) + ;; NOTE: doesn't work when capturing from string + ;; (when (boundp 'org-capture-templates-contexts) + ;; (push `(,gnus-icalendar-org-template-key "" ((in-mode . "gnus-article-mode"))) + ;; org-capture-templates-contexts)) + )) + +(defun gnus-icalendar:org-event-save (event reply-status) + (with-temp-buffer + (org-capture-string (gnus-icalendar-event->org-entry event reply-status) + gnus-icalendar-org-template-key))) + +(defun gnus-icalendar-show-org-agenda (event) + (let* ((time-delta (time-subtract (gnus-icalendar-event:end-time event) + (gnus-icalendar-event:start-time event))) + (duration-days (1+ (/ (+ (* (car time-delta) (expt 2 16)) + (cadr time-delta)) + 86400)))) + + (org-agenda-list nil (gnus-icalendar-event:start event) duration-days))) + +(defmethod gnus-icalendar-event:sync-to-org ((event gnus-icalendar-event-request) reply-status) + (if (gnus-icalendar-find-org-event-file event) + (gnus-icalendar--update-org-event event reply-status) + (gnus-icalendar:org-event-save event reply-status))) + +(defmethod gnus-icalendar-event:sync-to-org ((event gnus-icalendar-event-cancel)) + (when (gnus-icalendar-find-org-event-file event) + (gnus-icalendar--cancel-org-event event))) + +(defun gnus-icalendar-org-setup () + (if (and gnus-icalendar-org-capture-file gnus-icalendar-org-capture-headline) + (progn + (gnus-icalendar-insinuate-org-templates) + (setq gnus-icalendar-org-enabled-p t)) + (message "Cannot enable Calendar->Org: missing capture file, headline"))) + +;;; +;;; gnus-icalendar +;;; + +(defgroup gnus-icalendar nil + "Settings for inline display of iCalendar invitations." + :group 'gnus-article + :prefix "gnus-icalendar-") + +(defcustom gnus-icalendar-reply-bufname "*CAL*" + "Buffer used for building iCalendar invitation reply." + :type '(string) + :group 'gnus-icalendar) + +(make-variable-buffer-local + (defvar gnus-icalendar-reply-status nil)) + +(make-variable-buffer-local + (defvar gnus-icalendar-event nil)) + +(make-variable-buffer-local + (defvar gnus-icalendar-handle nil)) + +(defvar gnus-icalendar-identities + (apply #'append + (mapcar (lambda (x) (if (listp x) x (list x))) + (list user-full-name (regexp-quote user-mail-address) + ; NOTE: this one can be a list + gnus-ignored-from-addresses)))) + +;; TODO: make the template customizable +(defmethod gnus-icalendar-event->gnus-calendar ((event gnus-icalendar-event) &optional reply-status) + "Format an overview of EVENT details." + (flet ((format-header (x) + (format "%-12s%s" + (propertize (concat (car x) ":") 'face 'bold) + (cadr x)))) + + (with-slots (organizer summary description location recur uid method rsvp) event + (let ((headers `(("Summary" ,summary) + ("Location" ,location) + ("Time" ,(gnus-icalendar-event:org-timestamp event)) + ("Organizer" ,organizer) + ("Method" ,method)))) + + (when (and (not (gnus-icalendar-event-reply-p event)) rsvp) + (setq headers (append headers + `(("Status" ,(or reply-status "Not replied yet")))))) + + (concat + (mapconcat #'format-header headers "\n") + "\n\n" + description))))) + +(defmacro gnus-icalendar-with-decoded-handle (handle &rest body) + "Execute BODY in buffer containing the decoded contents of HANDLE." + (let ((charset (make-symbol "charset"))) + `(let ((,charset (cdr (assoc 'charset (mm-handle-type ,handle))))) + (with-temp-buffer + (mm-insert-part ,handle) + (when (string= ,charset "utf-8") + (mm-decode-coding-region (point-min) (point-max) 'utf-8)) + + ,@body)))) + + +(defun gnus-icalendar-event-from-handle (handle &optional attendee-name-or-email) + (gnus-icalendar-with-decoded-handle handle + (gnus-icalendar-event-from-buffer (current-buffer) attendee-name-or-email))) + +(defun gnus-icalendar-insert-button (text callback data) + ;; FIXME: the gnus-mime-button-map keymap does not make sense for this kind + ;; of button. + (let ((start (point))) + (gnus-add-text-properties + start + (progn + (insert "[ " text " ]") + (point)) + `(gnus-callback + ,callback + keymap ,gnus-mime-button-map + face ,gnus-article-button-face + gnus-data ,data)) + (widget-convert-button 'link start (point) + :action 'gnus-widget-press-button + :button-keymap gnus-widget-button-keymap))) + +(defun gnus-icalendar-send-buffer-by-mail (buffer-name subject) + (let ((message-signature nil)) + (with-current-buffer gnus-summary-buffer + (gnus-summary-reply) + (message-goto-body) + (mml-insert-multipart "alternative") + (mml-insert-empty-tag 'part 'type "text/plain") + (mml-attach-buffer buffer-name "text/calendar; method=REPLY; charset=UTF-8") + (message-goto-subject) + (delete-region (line-beginning-position) (line-end-position)) + (insert "Subject: " subject) + (message-send-and-exit)))) + +(defun gnus-icalendar-reply (data) + (let* ((handle (car data)) + (status (cadr data)) + (event (caddr data)) + (reply (gnus-icalendar-with-decoded-handle handle + (gnus-icalendar-event-reply-from-buffer + (current-buffer) status gnus-icalendar-identities)))) + + (when reply + (flet ((fold-icalendar-buffer () + (goto-char (point-min)) + (while (re-search-forward "^\\(.\\{72\\}\\)\\(.+\\)$" nil t) + (replace-match "\\1\n \\2") + (goto-char (line-beginning-position))))) + (let ((subject (concat (capitalize (symbol-name status)) + ": " (gnus-icalendar-event:summary event)))) + + (with-current-buffer (get-buffer-create gnus-icalendar-reply-bufname) + (delete-region (point-min) (point-max)) + (insert reply) + (fold-icalendar-buffer) + (gnus-icalendar-send-buffer-by-mail (buffer-name) subject)) + + ;; Back in article buffer + (setq-local gnus-icalendar-reply-status status) + (when gnus-icalendar-org-enabled-p + (gnus-icalendar--update-org-event event status) + ;; refresh article buffer to update the reply status + (with-current-buffer gnus-summary-buffer + (gnus-summary-show-article)))))))) + +(defun gnus-icalendar-sync-event-to-org (event) + (gnus-icalendar-event:sync-to-org event gnus-icalendar-reply-status)) + +(defmethod gnus-icalendar-event:inline-reply-buttons ((event gnus-icalendar-event) handle) + (when (gnus-icalendar-event:rsvp event) + `(("Accept" gnus-icalendar-reply (,handle accepted ,event)) + ("Tentative" gnus-icalendar-reply (,handle tentative ,event)) + ("Decline" gnus-icalendar-reply (,handle declined ,event))))) + +(defmethod gnus-icalendar-event:inline-reply-buttons ((event gnus-icalendar-event-reply) handle) + "No buttons for REPLY events." + nil) + +(defmethod gnus-icalendar-event:inline-reply-status ((event gnus-icalendar-event)) + (or (when gnus-icalendar-org-enabled-p + (gnus-icalendar--get-org-event-reply-status event)) + "Not replied yet")) + +(defmethod gnus-icalendar-event:inline-reply-status ((event gnus-icalendar-event-reply)) + "No reply status for REPLY events." + nil) + + +(defmethod gnus-icalendar-event:inline-org-buttons ((event gnus-icalendar-event)) + (let* ((org-entry-exists-p (gnus-icalendar-find-org-event-file event)) + (export-button-text (if org-entry-exists-p "Update Org Entry" "Export to Org"))) + + (delq nil (list + `("Show Agenda" gnus-icalendar-show-org-agenda ,event) + (when (gnus-icalendar-event-request-p event) + `(,export-button-text gnus-icalendar-sync-event-to-org ,event)) + (when org-entry-exists-p + `("Show Org Entry" gnus-icalendar--show-org-event ,event)))))) + +(defun gnus-icalendar-mm-inline (handle) + (let ((event (gnus-icalendar-event-from-handle handle gnus-icalendar-identities))) + + (setq gnus-icalendar-reply-status nil) + + (when event + (flet ((insert-button-group (buttons) + (when buttons + (mapc (lambda (x) + (apply 'gnus-icalendar-insert-button x) + (insert " ")) + buttons) + (insert "\n\n")))) + + (insert-button-group + (gnus-icalendar-event:inline-reply-buttons event handle)) + + (when gnus-icalendar-org-enabled-p + (insert-button-group (gnus-icalendar-event:inline-org-buttons event))) + + (setq gnus-icalendar-event event + gnus-icalendar-handle handle) + + (insert (gnus-icalendar-event->gnus-calendar + event + (gnus-icalendar-event:inline-reply-status event))))))) + +(defun gnus-icalendar-save-part (handle) + (let (event) + (when (and (equal (car (mm-handle-type handle)) "text/calendar") + (setq event (gnus-icalendar-event-from-handle handle gnus-icalendar-identities))) + + (gnus-icalendar-event:sync-to-org event)))) + + +(defun gnus-icalendar-save-event () + "Save the Calendar event in the text/calendar part under point." + (interactive) + (gnus-article-check-buffer) + (let ((data (get-text-property (point) 'gnus-data))) + (when data + (gnus-icalendar-save-part data)))) + +(defun gnus-icalendar-reply-accept () + "Accept invitation in the current article." + (interactive) + (with-current-buffer gnus-article-buffer + (gnus-icalendar-reply (list gnus-icalendar-handle 'accepted gnus-icalendar-event)) + (setq-local gnus-icalendar-reply-status 'accepted))) + +(defun gnus-icalendar-reply-tentative () + "Send tentative response to invitation in the current article." + (interactive) + (with-current-buffer gnus-article-buffer + (gnus-icalendar-reply (list gnus-icalendar-handle 'tentative gnus-icalendar-event)) + (setq-local gnus-icalendar-reply-status 'tentative))) + +(defun gnus-icalendar-reply-decline () + "Decline invitation in the current article." + (interactive) + (with-current-buffer gnus-article-buffer + (gnus-icalendar-reply (list gnus-icalendar-handle 'declined gnus-icalendar-event)) + (setq-local gnus-icalendar-reply-status 'declined))) + +(defun gnus-icalendar-event-export () + "Export calendar event to `org-mode', or update existing agenda entry." + (interactive) + (with-current-buffer gnus-article-buffer + (gnus-icalendar-sync-event-to-org gnus-icalendar-event)) + ;; refresh article buffer in case the reply had been sent before initial org + ;; export + (with-current-buffer gnus-summary-buffer + (gnus-summary-show-article))) + +(defun gnus-icalendar-event-show () + "Display `org-mode' agenda entry related to the calendar event." + (interactive) + (gnus-icalendar--show-org-event + (with-current-buffer gnus-article-buffer + gnus-icalendar-event))) + +(defun gnus-icalendar-event-check-agenda () + "Display `org-mode' agenda for days between event start and end dates." + (interactive) + (gnus-icalendar-show-org-agenda + (with-current-buffer gnus-article-buffer gnus-icalendar-event))) + +(defun gnus-icalendar-setup () + (add-to-list 'mm-inlined-types "text/calendar") + (add-to-list 'mm-automatic-display "text/calendar") + (add-to-list 'mm-inline-media-tests '("text/calendar" gnus-icalendar-mm-inline identity)) + + (gnus-define-keys (gnus-summary-calendar-map "i" gnus-summary-mode-map) + "a" gnus-icalendar-reply-accept + "t" gnus-icalendar-reply-tentative + "d" gnus-icalendar-reply-decline + "c" gnus-icalendar-event-check-agenda + "e" gnus-icalendar-event-export + "s" gnus-icalendar-event-show) + + (require 'gnus-art) + (add-to-list 'gnus-mime-action-alist + (cons "save calendar event" 'gnus-icalendar-save-event) + t)) + +(provide 'gnus-icalendar) + +;;; gnus-icalendar.el ends here === modified file 'lisp/gnus/gnus-int.el' --- lisp/gnus/gnus-int.el 2013-01-30 22:45:32 +0000 +++ lisp/gnus/gnus-int.el 2013-08-01 22:58:40 +0000 @@ -582,8 +582,8 @@ (gnus-group-method group))) (defun gnus-warp-to-article () - "Warps from an article in a virtual group to the article in its -real group. Does nothing on a real group." + "Jump from an article in a virtual group to the article in its real group. +Does nothing in a real group." (interactive) (when (gnus-virtual-group-p gnus-newsgroup-name) (let ((gnus-command-method === modified file 'lisp/gnus/gnus-start.el' --- lisp/gnus/gnus-start.el 2013-07-30 22:09:37 +0000 +++ lisp/gnus/gnus-start.el 2013-08-01 22:58:40 +0000 @@ -944,7 +944,8 @@ (when (and gnus-dribble-buffer (buffer-name gnus-dribble-buffer)) (with-current-buffer gnus-dribble-buffer - (save-buffer)))) + (when (> (buffer-size) 0) + (save-buffer))))) (defun gnus-dribble-clear () (when (gnus-buffer-exists-p gnus-dribble-buffer) === modified file 'lisp/gnus/gnus-uu.el' --- lisp/gnus/gnus-uu.el 2013-01-01 09:11:05 +0000 +++ lisp/gnus/gnus-uu.el 2013-08-01 22:58:40 +0000 @@ -640,7 +640,7 @@ (let ((level (gnus-summary-thread-level))) (while (and (gnus-summary-set-process-mark (gnus-summary-article-number)) - (zerop (gnus-summary-next-subject 1 nil t)) + (zerop (forward-line 1)) (> (gnus-summary-thread-level) level))))) (gnus-summary-position-point)) @@ -650,7 +650,7 @@ (let ((level (gnus-summary-thread-level))) (while (and (gnus-summary-remove-process-mark (gnus-summary-article-number)) - (zerop (gnus-summary-next-subject 1)) + (zerop (forward-line 1)) (> (gnus-summary-thread-level) level)))) (gnus-summary-position-point)) === modified file 'lisp/gnus/message.el' --- lisp/gnus/message.el 2013-07-06 23:40:56 +0000 +++ lisp/gnus/message.el 2013-08-01 22:58:40 +0000 @@ -264,7 +264,7 @@ :type 'sexp) (defcustom message-ignored-news-headers - "^NNTP-Posting-Host:\\|^Xref:\\|^[BGF]cc:\\|^Resent-Fcc:\\|^X-Draft-From:\\|^X-Gnus-Agent-Meta-Information:\\|^X-Message-SMTP-Method:" + "^NNTP-Posting-Host:\\|^Xref:\\|^[BGF]cc:\\|^Resent-Fcc:\\|^X-Draft-From:\\|^X-Gnus-Agent-Meta-Information:\\|^X-Message-SMTP-Method:\\|^X-Gnus-Delayed:" "*Regexp of headers to be removed unconditionally before posting." :group 'message-news :group 'message-headers === modified file 'lisp/gnus/mm-decode.el' --- lisp/gnus/mm-decode.el 2013-06-18 07:16:09 +0000 +++ lisp/gnus/mm-decode.el 2013-08-01 22:58:40 +0000 @@ -63,6 +63,18 @@ :group 'news :group 'multimedia) +(defface mm-command-output + '((((class color) + (background dark)) + (:foreground "ForestGreen")) + (((class color) + (background light)) + (:foreground "red3")) + (t + (:italic t))) + "Face used for displaying output from commands." + :group 'mime-display) + ;;; Convenience macros. (defmacro mm-handle-buffer (handle) @@ -983,9 +995,12 @@ (let ((buffer-read-only nil) (point (point))) (forward-line 2) - (mm-insert-inline - handle (with-current-buffer buffer - (buffer-string))) + (let ((start (point))) + (mm-insert-inline + handle (with-current-buffer buffer + (buffer-string))) + (put-text-property start (point) + 'face 'mm-command-output)) (goto-char point)))) (when (buffer-live-p buffer) (kill-buffer buffer))) === modified file 'lisp/gnus/mml2015.el' --- lisp/gnus/mml2015.el 2013-07-02 02:34:12 +0000 +++ lisp/gnus/mml2015.el 2013-08-01 22:58:40 +0000 @@ -885,17 +885,19 @@ (defun mml2015-epg-key-image-to-string (key-id) "Return a string with the image of a key, if any" - (let* ((result "") - (key-image (mml2015-epg-key-image key-id))) - (when key-image - (setq result " ") - (put-text-property - 1 2 'display - (gnus-rescale-image key-image - (cons mml2015-maximum-key-image-dimension - mml2015-maximum-key-image-dimension)) - result)) - result)) + (let ((key-image (mml2015-epg-key-image key-id))) + (if (not key-image) + "" + (condition-case error + (let ((result " ")) + (put-text-property + 1 2 'display + (gnus-rescale-image key-image + (cons mml2015-maximum-key-image-dimension + mml2015-maximum-key-image-dimension)) + result) + result) + (error ""))))) (defun mml2015-epg-signature-to-string (signature) (concat (epg-signature-to-string signature) === modified file 'lisp/gnus/nnmbox.el' --- lisp/gnus/nnmbox.el 2013-01-01 09:11:05 +0000 +++ lisp/gnus/nnmbox.el 2013-08-01 22:58:40 +0000 @@ -148,28 +148,29 @@ (deffoo nnmbox-request-article (article &optional newsgroup server buffer) (nnmbox-possibly-change-newsgroup newsgroup server) (with-current-buffer nnmbox-mbox-buffer - (when (nnmbox-find-article article) - (let (start stop) - (re-search-backward (concat "^" message-unix-mail-delimiter) nil t) - (setq start (point)) - (forward-line 1) - (setq stop (if (re-search-forward (concat "^" - message-unix-mail-delimiter) - nil 'move) - (match-beginning 0) - (point))) - (let ((nntp-server-buffer (or buffer nntp-server-buffer))) - (set-buffer nntp-server-buffer) - (erase-buffer) - (insert-buffer-substring nnmbox-mbox-buffer start stop) - (goto-char (point-min)) - (while (looking-at "From ") - (delete-char 5) - (insert "X-From-Line: ") - (forward-line 1)) - (if (numberp article) - (cons nnmbox-current-group article) - (nnmbox-article-group-number nil))))))) + (save-excursion + (when (nnmbox-find-article article) + (let (start stop) + (re-search-backward (concat "^" message-unix-mail-delimiter) nil t) + (setq start (point)) + (forward-line 1) + (setq stop (if (re-search-forward (concat "^" + message-unix-mail-delimiter) + nil 'move) + (match-beginning 0) + (point))) + (let ((nntp-server-buffer (or buffer nntp-server-buffer))) + (set-buffer nntp-server-buffer) + (erase-buffer) + (insert-buffer-substring nnmbox-mbox-buffer start stop) + (goto-char (point-min)) + (while (looking-at "From ") + (delete-char 5) + (insert "X-From-Line: ") + (forward-line 1)) + (if (numberp article) + (cons nnmbox-current-group article) + (nnmbox-article-group-number nil)))))))) (deffoo nnmbox-request-group (group &optional server dont-check info) (nnmbox-possibly-change-newsgroup nil server) @@ -255,14 +256,14 @@ (if (setq is-old (nnmail-expired-article-p newsgroup - (buffer-substring - (point) (progn (end-of-line) (point))) force)) + (buffer-substring (point) (line-end-position)) + force)) (progn (unless (eq nnmail-expiry-target 'delete) (with-temp-buffer (nnmbox-request-article (car articles) - newsgroup server - (current-buffer)) + newsgroup server + (current-buffer)) (let ((nnml-current-directory nil)) (nnmail-expiry-target-group nnmail-expiry-target newsgroup))) ------------------------------------------------------------ revno: 113639 committer: Juanma Barranquero branch nick: trunk timestamp: Fri 2013-08-02 00:53:03 +0200 message: Fix typos in ChangeLogs. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-08-01 18:46:10 +0000 +++ lisp/ChangeLog 2013-08-01 22:53:03 +0000 @@ -15,8 +15,8 @@ (tramp-handle-file-notify-rm-watch): New functions. (tramp-call-process): Do not bind `default-directory'. - * net/tramp-adb.el (tramp-adb-file-name-handler-alist): Order - alphabetically. + * net/tramp-adb.el (tramp-adb-file-name-handler-alist): + Order alphabetically. [access-file, add-name-to-file, dired-call-process]: [dired-compress-file, file-acl, file-notify-rm-watch]: [file-ownership-preserved-p, file-selinux-context]: @@ -36,8 +36,8 @@ (tramp-gvfs-file-gvfs-monitor-file-process-filter): New defuns. (tramp-gvfs-handle-write-region): Fix error in moving tmpfile. - * net/tramp-sh.el (tramp-sh-file-name-handler-alist): Order - alphabetically. + * net/tramp-sh.el (tramp-sh-file-name-handler-alist): + Order alphabetically. [file-notify-rm-watch ]: Use default Tramp handler. [executable-find]: Remove private handler. (tramp-do-copy-or-rename-file-out-of-band): Do not bind @@ -72,7 +72,7 @@ * ibuf-ext.el (ibuffer-filter-by-filename): Make it work with dired buffers too. -2013-07-31 Dmitry Antipov +2013-07-31 Dmitry Antipov * emacs-lisp/re-builder.el (reb-color-display-p): * files.el (save-buffers-kill-terminal): @@ -117,7 +117,7 @@ * vc/vc-hg.el (vc-hg-ignore): Remove `interactive'. Do not assume point-min==1. Fix search string. Fix parentheses missing. - * vc/vc-git.el (vc-git-ignore): Remove `interactive'. Do not + * vc/vc-git.el (vc-git-ignore): Remove `interactive'. Do not assume point-min==1. Fix search string. Fix parentheses missing. * vc/vc-cvs.el (vc-cvs-ignore): Remove `interactive'. @@ -181,7 +181,7 @@ * progmodes/cc-engine.el (c-beginning-of-statement-1) (c-after-conditional): Adapt to deal with c-block-stmt-1-2-key. * progmodes/cc-fonts.el (c-font-lock-declarations): Adapt to deal - with c-block-stmet-1-2-key. + with c-block-stmt-1-2-key. 2013-07-27 Juanma Barranquero === modified file 'src/ChangeLog' --- src/ChangeLog 2013-08-01 22:24:02 +0000 +++ src/ChangeLog 2013-08-01 22:53:03 +0000 @@ -429,7 +429,7 @@ code a bit. It makes no difference on POSIXish platforms but apparently it fixes a bug on w32. - Fix bug where insert-file-contents closes a file twice. (Bug#14839). + Fix bug where insert-file-contents closes a file twice (Bug#14839). * fileio.c (close_file_unwind): Don't close if FD is negative; this can happen when unwinding a zapped file descriptor. (Finsert_file_contents): Unwind-protect the fd before the point marker, @@ -582,7 +582,7 @@ (make_lispy_focus_in, make_lispy_focus_out): Declare and define. (kbd_buffer_get_event): For FOCUS_IN, make a focus_in event if no switch frame event is made. Check ! NILP (event->arg) if X11 (moved - from xterm.c). Make focus_out event for FOCUS_OUT_EVENT if NS or X11 + from xterm.c). Make focus_out event for FOCUS_OUT_EVENT if NS or X11 and there is a focused frame. (head_table): Add focus-in and focus-out. (keys_of_keyboard): Add focus-in and focus-out to Vspecial_event_map, @@ -955,7 +955,7 @@ (emacswrite_sig, emacs_perror): New functions. * xrdb.c (fatal): Don't invoke perror, since errno might be garbage. -2013-07-08 Magnus Henoch (tiny change). +2013-07-08 Magnus Henoch (tiny change) * image.c (imagemagick_load_image): Do not use MagickExportImagePixels on NS even if it is present. Pixmap on NS is a void*. @@ -1630,7 +1630,7 @@ Now static. * lisp.h: Remove the abovementioned defns and decls. - Use functions, not macros, for XINT etc. (Bug#11935). + Use functions, not macros, for XINT etc (Bug#11935). In lisp.h, prefer functions to function-like macros, and constants to object-like macros, when either will do. This: . simplifies use, as there's no more need to worry about ------------------------------------------------------------ revno: 113638 committer: Paul Eggert branch nick: trunk timestamp: Thu 2013-08-01 23:24:02 +0100 message: * fileio.c, fns.c (merge): Move extern decl from here ... * lisp.h (merge): ... to here. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-08-01 16:09:20 +0000 +++ src/ChangeLog 2013-08-01 22:24:02 +0000 @@ -1,3 +1,8 @@ +2013-08-01 Paul Eggert + + * fileio.c, fns.c (merge): Move extern decl from here ... + * lisp.h (merge): ... to here. + 2013-08-01 Dmitry Antipov Fix last font-related change. === modified file 'src/fileio.c' --- src/fileio.c 2013-07-25 08:07:47 +0000 +++ src/fileio.c 2013-08-01 22:24:02 +0000 @@ -5096,8 +5096,6 @@ return Qnil; } -Lisp_Object merge (Lisp_Object, Lisp_Object, Lisp_Object); - DEFUN ("car-less-than-car", Fcar_less_than_car, Scar_less_than_car, 2, 2, 0, doc: /* Return t if (car A) is numerically less than (car B). */) (Lisp_Object a, Lisp_Object b) === modified file 'src/fns.c' --- src/fns.c 2013-07-29 17:28:07 +0000 +++ src/fns.c 2013-08-01 22:24:02 +0000 @@ -1738,8 +1738,6 @@ return new; } -Lisp_Object merge (Lisp_Object org_l1, Lisp_Object org_l2, Lisp_Object pred); - DEFUN ("sort", Fsort, Ssort, 2, 2, 0, doc: /* Sort LIST, stably, comparing elements using PREDICATE. Returns the sorted list. LIST is modified by side effects. === modified file 'src/lisp.h' --- src/lisp.h 2013-07-19 01:24:35 +0000 +++ src/lisp.h 2013-08-01 22:24:02 +0000 @@ -3302,6 +3302,7 @@ extern Lisp_Object substring_both (Lisp_Object, ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t); +extern Lisp_Object merge (Lisp_Object, Lisp_Object, Lisp_Object); extern Lisp_Object do_yes_or_no_p (Lisp_Object); extern Lisp_Object concat2 (Lisp_Object, Lisp_Object); extern Lisp_Object concat3 (Lisp_Object, Lisp_Object, Lisp_Object); ------------------------------------------------------------ revno: 113637 committer: Tassilo Horn branch nick: trunk timestamp: Thu 2013-08-01 20:46:10 +0200 message: * speedbar.el (speedbar-query-confirmation-method): Doc fix. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-08-01 12:58:28 +0000 +++ lisp/ChangeLog 2013-08-01 18:46:10 +0000 @@ -1,5 +1,7 @@ 2013-08-01 Tassilo Horn + * speedbar.el (speedbar-query-confirmation-method): Doc fix. + * whitespace.el (whitespace-ensure-local-variables): New function. (whitespace-cleanup-region): Call it. (whitespace-turn-on): Call it. === modified file 'lisp/speedbar.el' --- lisp/speedbar.el 2013-05-22 03:13:56 +0000 +++ lisp/speedbar.el 2013-08-01 18:46:10 +0000 @@ -250,7 +250,7 @@ (defcustom speedbar-query-confirmation-method 'all "Query control for file operations. -The 'always flag means to always query before file operations. +The 'all flag means to always query before file operations. The 'none-but-delete flag means to not query before any file operations, except before a file deletion." :group 'speedbar ------------------------------------------------------------ revno: 113636 committer: Dmitry Antipov branch nick: trunk timestamp: Thu 2013-08-01 20:09:20 +0400 message: Fix last font-related change. * w32font.h (w32font_list_internal, w32font_match_internal): Fix prototype. * w32uniscribe.c (uniscribe_list, uniscribe_match): (uniscribe_list_family): Adjust to match font API change. MS-Windows breakage reported by Juanma Barranquero at http://lists.gnu.org/archive/html/emacs-devel/2013-08/msg00006.html. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-08-01 14:54:29 +0000 +++ src/ChangeLog 2013-08-01 16:09:20 +0000 @@ -1,5 +1,15 @@ 2013-08-01 Dmitry Antipov + Fix last font-related change. + * w32font.h (w32font_list_internal, w32font_match_internal): + Fix prototype. + * w32uniscribe.c (uniscribe_list, uniscribe_match): + (uniscribe_list_family): Adjust to match font API change. + MS-Windows breakage reported by Juanma Barranquero + at http://lists.gnu.org/archive/html/emacs-devel/2013-08/msg00006.html. + +2013-08-01 Dmitry Antipov + * frame.h (FRAME_MOUSE_UPDATE): * nsterm.m (ns_frame_up_to_date): Omit redundant check whether hlinfo->mouse_face_mouse_frame is non-NULL. === modified file 'src/w32font.h' --- src/w32font.h 2013-01-01 09:11:05 +0000 +++ src/w32font.h 2013-08-01 16:09:20 +0000 @@ -64,10 +64,10 @@ #define CACHE_BLOCKSIZE 128 Lisp_Object w32font_get_cache (FRAME_PTR fe); -Lisp_Object w32font_list_internal (Lisp_Object frame, +Lisp_Object w32font_list_internal (struct frame *f, Lisp_Object font_spec, int opentype_only); -Lisp_Object w32font_match_internal (Lisp_Object frame, +Lisp_Object w32font_match_internal (struct frame *f, Lisp_Object font_spec, int opentype_only); int w32font_open_internal (FRAME_PTR f, Lisp_Object font_entity, === modified file 'src/w32uniscribe.c' --- src/w32uniscribe.c 2013-03-04 07:41:01 +0000 +++ src/w32uniscribe.c 2013-08-01 16:09:20 +0000 @@ -69,28 +69,27 @@ /* Font backend interface implementation. */ static Lisp_Object -uniscribe_list (Lisp_Object frame, Lisp_Object font_spec) +uniscribe_list (struct frame *f, Lisp_Object font_spec) { - Lisp_Object fonts = w32font_list_internal (frame, font_spec, 1); + Lisp_Object fonts = w32font_list_internal (f, font_spec, 1); FONT_ADD_LOG ("uniscribe-list", font_spec, fonts); return fonts; } static Lisp_Object -uniscribe_match (Lisp_Object frame, Lisp_Object font_spec) +uniscribe_match (struct frame *f, Lisp_Object font_spec) { - Lisp_Object entity = w32font_match_internal (frame, font_spec, 1); + Lisp_Object entity = w32font_match_internal (f, font_spec, 1); FONT_ADD_LOG ("uniscribe-match", font_spec, entity); return entity; } static Lisp_Object -uniscribe_list_family (Lisp_Object frame) +uniscribe_list_family (struct frame *f) { Lisp_Object list = Qnil; LOGFONT font_match_pattern; HDC dc; - FRAME_PTR f = XFRAME (frame); memset (&font_match_pattern, 0, sizeof (font_match_pattern)); /* Limit enumerated fonts to outline fonts to save time. */ ------------------------------------------------------------ revno: 113635 committer: Dmitry Antipov branch nick: trunk timestamp: Thu 2013-08-01 18:54:29 +0400 message: * frame.h (FRAME_MOUSE_UPDATE): * nsterm.m (ns_frame_up_to_date): Omit redundant check whether hlinfo->mouse_face_mouse_frame is non-NULL. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-08-01 10:33:25 +0000 +++ src/ChangeLog 2013-08-01 14:54:29 +0000 @@ -1,5 +1,11 @@ 2013-08-01 Dmitry Antipov + * frame.h (FRAME_MOUSE_UPDATE): + * nsterm.m (ns_frame_up_to_date): Omit redundant check + whether hlinfo->mouse_face_mouse_frame is non-NULL. + +2013-08-01 Dmitry Antipov + Avoid redundant Lisp_Object <-> struct frame conversions in font API. * font.h (struct font_driver): Change list, match, and list_family functions to accept struct frame * as first arg. === modified file 'src/frame.h' --- src/frame.h 2013-08-01 06:38:49 +0000 +++ src/frame.h 2013-08-01 14:54:29 +0000 @@ -929,10 +929,9 @@ if (frame == hlinfo->mouse_face_mouse_frame) \ { \ block_input (); \ - if (hlinfo->mouse_face_mouse_frame) \ - note_mouse_highlight (hlinfo->mouse_face_mouse_frame, \ - hlinfo->mouse_face_mouse_x, \ - hlinfo->mouse_face_mouse_y); \ + note_mouse_highlight (hlinfo->mouse_face_mouse_frame, \ + hlinfo->mouse_face_mouse_x, \ + hlinfo->mouse_face_mouse_y); \ unblock_input (); \ } \ } while (0) === modified file 'src/nsterm.m' --- src/nsterm.m 2013-08-01 06:38:49 +0000 +++ src/nsterm.m 2013-08-01 14:54:29 +0000 @@ -1883,10 +1883,9 @@ { block_input (); ns_update_begin(f); - if (hlinfo->mouse_face_mouse_frame) - note_mouse_highlight (hlinfo->mouse_face_mouse_frame, - hlinfo->mouse_face_mouse_x, - hlinfo->mouse_face_mouse_y); + note_mouse_highlight (hlinfo->mouse_face_mouse_frame, + hlinfo->mouse_face_mouse_x, + hlinfo->mouse_face_mouse_y); ns_update_end(f); unblock_input (); } ------------------------------------------------------------ revno: 113634 committer: Tassilo Horn branch nick: trunk timestamp: Thu 2013-08-01 14:58:28 +0200 message: Refactor out setting `whitespace-indent-tabs-mode' and `whitespace-tab-width' buffer-locally to own function, so that `whitespace-cleanup' and friends work appropriately without needing to enable `whitespace-mode'. * whitespace.el (whitespace-ensure-local-variables): New function. (whitespace-cleanup-region): Call it. (whitespace-turn-on): Call it. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-08-01 11:10:31 +0000 +++ lisp/ChangeLog 2013-08-01 12:58:28 +0000 @@ -1,3 +1,9 @@ +2013-08-01 Tassilo Horn + + * whitespace.el (whitespace-ensure-local-variables): New function. + (whitespace-cleanup-region): Call it. + (whitespace-turn-on): Call it. + 2013-08-01 Michael Albinus Complete file name handlers. === modified file 'lisp/whitespace.el' --- lisp/whitespace.el 2013-05-09 01:40:20 +0000 +++ lisp/whitespace.el 2013-08-01 12:58:28 +0000 @@ -1471,6 +1471,12 @@ ;; PROBLEM 6: 8 or more SPACEs after TAB (whitespace-cleanup-region (point-min) (point-max))))) +(defun whitespace-ensure-local-variables () + "Set `whitespace-indent-tabs-mode' and `whitespace-tab-width' locally." + (set (make-local-variable 'whitespace-indent-tabs-mode) + indent-tabs-mode) + (set (make-local-variable 'whitespace-tab-width) + tab-width)) ;;;###autoload (defun whitespace-cleanup-region (start end) @@ -1517,6 +1523,7 @@ ;; read-only buffer (whitespace-warn-read-only "cleanup region") ;; non-read-only buffer + (whitespace-ensure-local-variables) (let ((rstart (min start end)) (rend (copy-marker (max start end))) (indent-tabs-mode whitespace-indent-tabs-mode) @@ -2095,7 +2102,6 @@ (defvar whitespace-display-table-was-local nil "Used to remember whether a buffer initially had a local display table.") - (defun whitespace-turn-on () "Turn on whitespace visualization." ;; prepare local hooks @@ -2108,10 +2114,7 @@ (if (listp whitespace-style) whitespace-style (list whitespace-style))) - (set (make-local-variable 'whitespace-indent-tabs-mode) - indent-tabs-mode) - (set (make-local-variable 'whitespace-tab-width) - tab-width) + (whitespace-ensure-local-variables) ;; turn on whitespace (when whitespace-active-style (whitespace-color-on) ------------------------------------------------------------ revno: 113633 author: Lars Magne Ingebrigtsen committer: Katsumi Yamaoka branch nick: trunk timestamp: Thu 2013-08-01 11:23:38 +0000 message: lisp/gnus/nnrss.el (nnrss-discover-feed): Indent diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2013-08-01 03:51:41 +0000 +++ lisp/gnus/ChangeLog 2013-08-01 11:23:38 +0000 @@ -1,3 +1,7 @@ +2013-08-01 Lars Magne Ingebrigtsen + + * nnrss.el (nnrss-discover-feed): Indent. + 2013-08-01 Katsumi Yamaoka * gnus-util.el (gnus-emacs-completing-read): Isolate XEmacs stuff. === modified file 'lisp/gnus/nnrss.el' --- lisp/gnus/nnrss.el 2013-01-01 09:11:05 +0000 +++ lisp/gnus/nnrss.el 2013-08-01 11:23:38 +0000 @@ -933,30 +933,30 @@ rss-offsite-in rdf-offsite-in xml-offsite-in))) (defun nnrss-discover-feed (url) - "Given a page, find an RSS feed using Mark Pilgrim's -`ultra-liberal rss locator'." - + "Given a page, find an RSS feed. +Use Mark Pilgrim's `ultra-liberal rss locator'." (let ((parsed-page (nnrss-fetch url))) - -;; 1. if this url is the rss, use it. + ;; 1. if this url is the rss, use it. (if (nnrss-rss-p parsed-page) (let ((rss-ns (nnrss-get-namespace-prefix parsed-page "http://purl.org/rss/1.0/"))) (nnrss-rss-title-description rss-ns parsed-page url)) -;; 2. look for the branch nick: trunk timestamp: Thu 2013-08-01 13:10:31 +0200 message: Complete file name handlers. * net/tramp.el (tramp-handle-set-visited-file-modtime) (tramp-handle-verify-visited-file-modtime) (tramp-handle-file-notify-rm-watch): New functions. (tramp-call-process): Do not bind `default-directory'. * net/tramp-adb.el (tramp-adb-file-name-handler-alist): Order alphabetically. [access-file, add-name-to-file, dired-call-process]: [dired-compress-file, file-acl, file-notify-rm-watch]: [file-ownership-preserved-p, file-selinux-context]: [make-directory-internal, make-symbolic-link, set-file-acl]: [set-file-selinux-context, set-visited-file-modtime]: [verify-visited-file-modtime]: Add handler. (tramp-adb-handle-write-region): Apply `set-visited-file-modtime'. * net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist) [file-notify-add-watch, file-notify-rm-watch]: [set-file-times, set-visited-file-modtime]: [verify-visited-file-modtime]: Add handler. (with-tramp-gvfs-error-message) (tramp-gvfs-handle-set-visited-file-modtime) (tramp-gvfs-fuse-file-name): Remove. (tramp-gvfs-handle-file-notify-add-watch) (tramp-gvfs-file-gvfs-monitor-file-process-filter): New defuns. (tramp-gvfs-handle-write-region): Fix error in moving tmpfile. * net/tramp-sh.el (tramp-sh-file-name-handler-alist): Order alphabetically. [file-notify-rm-watch ]: Use default Tramp handler. [executable-find]: Remove private handler. (tramp-do-copy-or-rename-file-out-of-band): Do not bind `default-directory'. (tramp-sh-handle-executable-find) (tramp-sh-handle-file-notify-rm-watch): Remove functions. (tramp-sh-file-gvfs-monitor-dir-process-filter) (tramp-sh-file-inotifywait-process-filter, tramp-set-remote-path): Do not use `format' in `tramp-message'. * net/tramp-smb.el (tramp-smb-file-name-handler-alist) [file-notify-rm-watch, set-visited-file-modtime]: [verify-visited-file-modtime]: Add handler. (tramp-smb-call-winexe): Do not bind `default-directory'. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-08-01 00:19:11 +0000 +++ lisp/ChangeLog 2013-08-01 11:10:31 +0000 @@ -1,3 +1,50 @@ +2013-08-01 Michael Albinus + + Complete file name handlers. + + * net/tramp.el (tramp-handle-set-visited-file-modtime) + (tramp-handle-verify-visited-file-modtime) + (tramp-handle-file-notify-rm-watch): New functions. + (tramp-call-process): Do not bind `default-directory'. + + * net/tramp-adb.el (tramp-adb-file-name-handler-alist): Order + alphabetically. + [access-file, add-name-to-file, dired-call-process]: + [dired-compress-file, file-acl, file-notify-rm-watch]: + [file-ownership-preserved-p, file-selinux-context]: + [make-directory-internal, make-symbolic-link, set-file-acl]: + [set-file-selinux-context, set-visited-file-modtime]: + [verify-visited-file-modtime]: Add handler. + (tramp-adb-handle-write-region): Apply `set-visited-file-modtime'. + + * net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist) + [file-notify-add-watch, file-notify-rm-watch]: + [set-file-times, set-visited-file-modtime]: + [verify-visited-file-modtime]: Add handler. + (with-tramp-gvfs-error-message) + (tramp-gvfs-handle-set-visited-file-modtime) + (tramp-gvfs-fuse-file-name): Remove. + (tramp-gvfs-handle-file-notify-add-watch) + (tramp-gvfs-file-gvfs-monitor-file-process-filter): New defuns. + (tramp-gvfs-handle-write-region): Fix error in moving tmpfile. + + * net/tramp-sh.el (tramp-sh-file-name-handler-alist): Order + alphabetically. + [file-notify-rm-watch ]: Use default Tramp handler. + [executable-find]: Remove private handler. + (tramp-do-copy-or-rename-file-out-of-band): Do not bind + `default-directory'. + (tramp-sh-handle-executable-find) + (tramp-sh-handle-file-notify-rm-watch): Remove functions. + (tramp-sh-file-gvfs-monitor-dir-process-filter) + (tramp-sh-file-inotifywait-process-filter, tramp-set-remote-path): + Do not use `format' in `tramp-message'. + + * net/tramp-smb.el (tramp-smb-file-name-handler-alist) + [file-notify-rm-watch, set-visited-file-modtime]: + [verify-visited-file-modtime]: Add handler. + (tramp-smb-call-winexe): Do not bind `default-directory'. + 2013-08-01 Xue Fuqiao * vc/vc-hooks.el (vc-menu-map): Fix menu entry for vc-ignore. === modified file 'lisp/net/tramp-adb.el' --- lisp/net/tramp-adb.el 2013-07-24 13:29:15 +0000 +++ lisp/net/tramp-adb.el 2013-08-01 11:10:31 +0000 @@ -85,53 +85,74 @@ (cons 'tramp-adb-file-name-p 'tramp-adb-file-name-handler)) (defconst tramp-adb-file-name-handler-alist - '((directory-file-name . tramp-handle-directory-file-name) + '((access-file . ignore) + (add-name-to-file . tramp-adb-handle-copy-file) + ;; `byte-compiler-base-file-name' performed by default handler. + ;; `copy-directory' performed by default handler. + (copy-file . tramp-adb-handle-copy-file) + (delete-directory . tramp-adb-handle-delete-directory) + (delete-file . tramp-adb-handle-delete-file) + ;; `diff-latest-backup-file' performed by default handler. + (directory-file-name . tramp-handle-directory-file-name) + (directory-files . tramp-handle-directory-files) + (directory-files-and-attributes + . tramp-adb-handle-directory-files-and-attributes) + (dired-call-process . ignore) + (dired-compress-file . ignore) (dired-uncache . tramp-handle-dired-uncache) + (expand-file-name . tramp-adb-handle-expand-file-name) + (file-accessible-directory-p . tramp-handle-file-accessible-directory-p) + (file-acl . ignore) + (file-attributes . tramp-adb-handle-file-attributes) + (file-directory-p . tramp-adb-handle-file-directory-p) + ;; `file-equal-p' performed by default handler. + ;; FIXME: This is too sloppy. + (file-executable-p . tramp-handle-file-exists-p) + (file-exists-p . tramp-handle-file-exists-p) + ;; `file-in-directory-p' performed by default handler. + (file-local-copy . tramp-adb-handle-file-local-copy) + (file-modes . tramp-handle-file-modes) + (file-name-all-completions . tramp-adb-handle-file-name-all-completions) (file-name-as-directory . tramp-handle-file-name-as-directory) (file-name-completion . tramp-handle-file-name-completion) - (file-name-all-completions . tramp-adb-handle-file-name-all-completions) - (file-attributes . tramp-adb-handle-file-attributes) (file-name-directory . tramp-handle-file-name-directory) (file-name-nondirectory . tramp-handle-file-name-nondirectory) - (file-truename . tramp-adb-handle-file-truename) + ;; `file-name-sans-versions' performed by default handler. (file-newer-than-file-p . tramp-handle-file-newer-than-file-p) - (file-name-as-directory . tramp-handle-file-name-as-directory) + (file-notify-add-watch . tramp-handle-file-notify-add-watch) + (file-notify-rm-watch . tramp-handle-file-notify-rm-watch) + (file-ownership-preserved-p . ignore) + (file-readable-p . tramp-handle-file-exists-p) (file-regular-p . tramp-handle-file-regular-p) (file-remote-p . tramp-handle-file-remote-p) - (file-accessible-directory-p . tramp-handle-file-accessible-directory-p) - (file-directory-p . tramp-adb-handle-file-directory-p) + (file-selinux-context . ignore) (file-symlink-p . tramp-handle-file-symlink-p) - ;; FIXME: This is too sloppy. - (file-executable-p . tramp-handle-file-exists-p) - (file-exists-p . tramp-handle-file-exists-p) - (file-readable-p . tramp-handle-file-exists-p) + (file-truename . tramp-adb-handle-file-truename) (file-writable-p . tramp-adb-handle-file-writable-p) - (file-local-copy . tramp-adb-handle-file-local-copy) - (file-modes . tramp-handle-file-modes) - (file-notify-add-watch . tramp-handle-file-notify-add-watch) - (file-notify-rm-watch . ignore) - (expand-file-name . tramp-adb-handle-expand-file-name) (find-backup-file-name . tramp-handle-find-backup-file-name) - (directory-files . tramp-handle-directory-files) - (directory-files-and-attributes - . tramp-adb-handle-directory-files-and-attributes) - (make-directory . tramp-adb-handle-make-directory) - (delete-directory . tramp-adb-handle-delete-directory) - (delete-file . tramp-adb-handle-delete-file) - (load . tramp-handle-load) + ;; `find-file-noselect' performed by default handler. + ;; `get-file-buffer' performed by default handler. (insert-directory . tramp-adb-handle-insert-directory) (insert-file-contents . tramp-handle-insert-file-contents) - (substitute-in-file-name . tramp-handle-substitute-in-file-name) - (unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory) - (vc-registered . ignore) ;no vc control files on Android devices - (write-region . tramp-adb-handle-write-region) + (load . tramp-handle-load) + ;; `make-auto-save-file-name' performed by default handler. + (make-directory . tramp-adb-handle-make-directory) + (make-directory-internal . ignore) + (make-symbolic-link . ignore) + (process-file . tramp-adb-handle-process-file) + (rename-file . tramp-adb-handle-rename-file) + (set-file-acl . ignore) (set-file-modes . tramp-adb-handle-set-file-modes) + (set-file-selinux-context . ignore) (set-file-times . tramp-adb-handle-set-file-times) - (copy-file . tramp-adb-handle-copy-file) - (rename-file . tramp-adb-handle-rename-file) - (process-file . tramp-adb-handle-process-file) + (set-visited-file-modtime . tramp-handle-set-visited-file-modtime) (shell-command . tramp-adb-handle-shell-command) - (start-file-process . tramp-adb-handle-start-file-process)) + (start-file-process . tramp-adb-handle-start-file-process) + (substitute-in-file-name . tramp-handle-substitute-in-file-name) + (unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory) + (vc-registered . ignore) + (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime) + (write-region . tramp-adb-handle-write-region)) "Alist of handler functions for Tramp ADB method.") ;; It must be a `defsubst' in order to push the whole code into @@ -599,6 +620,9 @@ (tramp-error v 'file-error "Cannot write: `%s' filename")) (delete-file tmpfile))) + (when (or (eq visit t) (stringp visit)) + (set-visited-file-modtime)) + (unless (equal curbuf (current-buffer)) (tramp-error v 'file-error === modified file 'lisp/net/tramp-gvfs.el' --- lisp/net/tramp-gvfs.el 2013-07-24 13:29:15 +0000 +++ lisp/net/tramp-gvfs.el 2013-08-01 11:10:31 +0000 @@ -403,10 +403,10 @@ ;; New handlers should be added here. (defconst tramp-gvfs-file-name-handler-alist - '( - (access-file . ignore) + '((access-file . ignore) (add-name-to-file . tramp-gvfs-handle-copy-file) ;; `byte-compiler-base-file-name' performed by default handler. + ;; `copy-directory' performed by default handler. (copy-file . tramp-gvfs-handle-copy-file) (delete-directory . tramp-gvfs-handle-delete-directory) (delete-file . tramp-gvfs-handle-delete-file) @@ -418,14 +418,15 @@ (dired-call-process . ignore) (dired-compress-file . ignore) (dired-uncache . tramp-handle-dired-uncache) - ;; `executable-find' is not official yet. performed by default handler. (expand-file-name . tramp-gvfs-handle-expand-file-name) (file-accessible-directory-p . tramp-handle-file-accessible-directory-p) (file-acl . ignore) (file-attributes . tramp-gvfs-handle-file-attributes) (file-directory-p . tramp-gvfs-handle-file-directory-p) + ;; `file-equal-p' performed by default handler. (file-executable-p . tramp-gvfs-handle-file-executable-p) (file-exists-p . tramp-handle-file-exists-p) + ;; `file-in-directory-p' performed by default handler. (file-local-copy . tramp-gvfs-handle-file-local-copy) (file-modes . tramp-handle-file-modes) (file-name-all-completions . tramp-gvfs-handle-file-name-all-completions) @@ -435,8 +436,8 @@ (file-name-nondirectory . tramp-handle-file-name-nondirectory) ;; `file-name-sans-versions' performed by default handler. (file-newer-than-file-p . tramp-handle-file-newer-than-file-p) - (file-notify-add-watch . tramp-handle-file-notify-add-watch) - (file-notify-rm-watch . ignore) + (file-notify-add-watch . tramp-gvfs-handle-file-notify-add-watch) + (file-notify-rm-watch . tramp-handle-file-notify-rm-watch) (file-ownership-preserved-p . ignore) (file-readable-p . tramp-gvfs-handle-file-readable-p) (file-regular-p . tramp-handle-file-regular-p) @@ -451,6 +452,7 @@ (insert-directory . tramp-gvfs-handle-insert-directory) (insert-file-contents . tramp-gvfs-handle-insert-file-contents) (load . tramp-handle-load) + ;; `make-auto-save-file-name' performed by default handler. (make-directory . tramp-gvfs-handle-make-directory) (make-directory-internal . ignore) (make-symbolic-link . ignore) @@ -459,15 +461,15 @@ (set-file-acl . ignore) (set-file-modes . ignore) (set-file-selinux-context . ignore) - (set-visited-file-modtime . tramp-gvfs-handle-set-visited-file-modtime) + (set-file-times . ignore) + (set-visited-file-modtime . tramp-handle-set-visited-file-modtime) (shell-command . ignore) (start-file-process . ignore) (substitute-in-file-name . tramp-handle-substitute-in-file-name) (unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory) (vc-registered . ignore) - ;; `verify-visited-file-modtime' performed by default handler. - (write-region . tramp-gvfs-handle-write-region) -) + (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime) + (write-region . tramp-gvfs-handle-write-region)) "Alist of handler functions for Tramp GVFS method. Operations not mentioned here will be handled by the default Emacs primitives.") @@ -555,28 +557,6 @@ (tramp-compat-font-lock-add-keywords 'emacs-lisp-mode '("\\")) -(defmacro with-tramp-gvfs-error-message (filename handler &rest args) - "Apply a Tramp GVFS `handler'. -In case of an error, modify the error message by replacing -`filename' with its GVFS mounted name." - `(let ((fuse-file-name (regexp-quote (tramp-gvfs-fuse-file-name ,filename))) - elt) - (condition-case err - (tramp-compat-funcall ,handler ,@args) - (error - (setq elt (cdr err)) - (while elt - (when (and (stringp (car elt)) - (string-match fuse-file-name (car elt))) - (setcar elt (replace-match ,filename t t (car elt)))) - (setq elt (cdr elt))) - (signal (car err) (cdr err)))))) - -(put 'with-tramp-gvfs-error-message 'lisp-indent-function 2) -(put 'with-tramp-gvfs-error-message 'edebug-form-spec '(form symbolp body)) -(tramp-compat-font-lock-add-keywords - 'emacs-lisp-mode '("\\")) - (defvar tramp-gvfs-dbus-event-vector nil "Current Tramp file name to be used, as vector. It is needed when D-Bus signals or errors arrive, because there @@ -943,6 +923,64 @@ v (concat localname filename) "file-name-all-completions" result)))))))) +(defun tramp-gvfs-handle-file-notify-add-watch (file-name flags callback) + "Like `file-notify-add-watch' for Tramp files." + (setq file-name (expand-file-name file-name)) + (with-parsed-tramp-file-name file-name nil + (let ((p (start-process + "gvfs-monitor-file" (generate-new-buffer " *gvfs-monitor-file*") + "gvfs-monitor-file" (tramp-gvfs-url-file-name file-name)))) + (if (not (processp p)) + (tramp-error + v 'file-notify-error "gvfs-monitor-file failed to start") + (tramp-compat-set-process-query-on-exit-flag p nil) + (set-process-filter p 'tramp-gvfs-file-gvfs-monitor-file-process-filter) + (with-current-buffer (process-buffer p) + (setq default-directory (file-name-directory file-name))) + p)))) + +(defun tramp-gvfs-file-gvfs-monitor-file-process-filter (proc string) + "Read output from \"gvfs-monitor-file\" and add corresponding file-notify events." + (let* ((rest-string (tramp-compat-process-get proc 'rest-string)) + (dd (with-current-buffer (process-buffer proc) default-directory)) + (ddu (regexp-quote (tramp-gvfs-url-file-name dd)))) + (when rest-string + (tramp-message proc 10 "Previous string:\n%s" rest-string)) + (tramp-message proc 6 "%S\n%s" proc string) + (setq string (concat rest-string string) + ;; Attribute change is returned in unused wording. + string (replace-regexp-in-string + "ATTRIB CHANGED" "ATTRIBUTE_CHANGED" string)) + + (while (string-match + (concat "^[\n\r]*" + "File Monitor Event:[\n\r]+" + "File = \\([^\n\r]+\\)[\n\r]+" + "Event = \\([^[:blank:]]+\\)[\n\r]+") + string) + (let ((action (intern-soft + (replace-regexp-in-string + "_" "-" (downcase (match-string 2 string))))) + (file (match-string 1 string))) + (setq string (replace-match "" nil nil string)) + ;; File names are returned as URL paths. We must convert them. + (when (string-match ddu file) + (setq file (replace-match dd nil nil file))) + (while (string-match "%\\([0-9A-F]\\{2\\}\\)" file) + (setq file + (replace-match + (char-to-string (string-to-number (match-string 1 file) 16)) + nil nil file))) + ;; Usually, we would add an Emacs event now. Unfortunately, + ;; `unread-command-events' does not accept several events at + ;; once. Therefore, we apply the callback directly. + (tramp-compat-funcall 'file-notify-callback (list proc action file)))) + + ;; Save rest of the string. + (when (zerop (length string)) (setq string nil)) + (when string (tramp-message proc 10 "Rest string:\n%s" string)) + (tramp-compat-process-put proc 'rest-string string))) + (defun tramp-gvfs-handle-file-readable-p (filename) "Like `file-readable-p' for Tramp files." (with-parsed-tramp-file-name filename nil @@ -1054,22 +1092,6 @@ (tramp-flush-file-property v (file-name-directory localname)) (tramp-flush-file-property v localname)))))) -(defun tramp-gvfs-handle-set-visited-file-modtime (&optional time-list) - "Like `set-visited-file-modtime' for Tramp files." - (unless (buffer-file-name) - (error "Can't set-visited-file-modtime: buffer `%s' not visiting a file" - (buffer-name))) - (unless time-list - (let ((f (buffer-file-name))) - (with-parsed-tramp-file-name f nil - (let ((remote-file-name-inhibit-cache t) - (attr (file-attributes f))) - ;; '(-1 65535) means file doesn't exists yet. - (setq time-list (or (nth 5 attr) '(-1 65535))))))) - ;; We use '(0 0) as a don't-know value. - (unless (not (equal time-list '(0 0))) - (tramp-run-real-handler 'set-visited-file-modtime (list time-list)))) - (defun tramp-gvfs-handle-write-region (start end filename &optional append visit lockname confirm) "Like `write-region' for Tramp files." @@ -1082,7 +1104,7 @@ (let ((tmpfile (tramp-compat-make-temp-file filename))) (write-region start end tmpfile) (condition-case nil - (rename-file tmpfile filename) + (rename-file tmpfile filename 'ok-if-already-exists) (error (delete-file tmpfile) (tramp-error @@ -1137,24 +1159,6 @@ (dbus-unescape-from-identifier (replace-regexp-in-string "^.*/\\([^/]+\\)$" "\\1" object-path))) -(defun tramp-gvfs-fuse-file-name (filename) - "Return FUSE file name, which is directly accessible." - (with-parsed-tramp-file-name (expand-file-name filename) nil - (tramp-gvfs-maybe-open-connection v) - (let ((prefix (tramp-get-file-property v "/" "prefix" "")) - (fuse-mountpoint - (tramp-get-file-property v "/" "fuse-mountpoint" nil))) - (unless fuse-mountpoint - (tramp-error - v 'file-error "There is no FUSE mount point for `%s'" filename)) - ;; We must hide the prefix, if any. - (when (string-match (concat "^" (regexp-quote prefix)) localname) - (setq localname (replace-match "" t t localname))) - (tramp-message - v 10 "remote file `%s' is local file `%s'" - filename (concat fuse-mountpoint localname)) - (concat fuse-mountpoint localname)))) - (defun tramp-bluez-address (device) "Return bluetooth device address from a given bluetooth DEVICE name." (when (stringp device) === modified file 'lisp/net/tramp-sh.el' --- lisp/net/tramp-sh.el 2013-07-29 07:47:53 +0000 +++ lisp/net/tramp-sh.el 2013-08-01 11:10:31 +0000 @@ -801,73 +801,78 @@ here-document, otherwise the command could exceed maximum length of command line.") -;; New handlers should be added here. The following operations can be -;; handled using the normal primitives: file-name-sans-versions, -;; get-file-buffer. +;; New handlers should be added here. (defconst tramp-sh-file-name-handler-alist - '((load . tramp-handle-load) - (make-symbolic-link . tramp-sh-handle-make-symbolic-link) + '(;; `access-file' performed by default handler. + (add-name-to-file . tramp-sh-handle-add-name-to-file) + ;; `byte-compiler-base-file-name' performed by default handler. + (copy-directory . tramp-sh-handle-copy-directory) + (copy-file . tramp-sh-handle-copy-file) + (delete-directory . tramp-sh-handle-delete-directory) + (delete-file . tramp-sh-handle-delete-file) + ;; `diff-latest-backup-file' performed by default handler. + (directory-file-name . tramp-handle-directory-file-name) + (directory-files . tramp-handle-directory-files) + (directory-files-and-attributes + . tramp-sh-handle-directory-files-and-attributes) + ;; `dired-call-process' performed by default handler. + (dired-compress-file . tramp-sh-handle-dired-compress-file) + (dired-recursive-delete-directory + . tramp-sh-handle-dired-recursive-delete-directory) + (dired-uncache . tramp-handle-dired-uncache) + (expand-file-name . tramp-sh-handle-expand-file-name) + (file-accessible-directory-p . tramp-handle-file-accessible-directory-p) + (file-acl . tramp-sh-handle-file-acl) + (file-attributes . tramp-sh-handle-file-attributes) + (file-directory-p . tramp-sh-handle-file-directory-p) + ;; `file-equal-p' performed by default handler. + (file-executable-p . tramp-sh-handle-file-executable-p) + (file-exists-p . tramp-sh-handle-file-exists-p) + ;; `file-in-directory-p' performed by default handler. + (file-local-copy . tramp-sh-handle-file-local-copy) + (file-modes . tramp-handle-file-modes) + (file-name-all-completions . tramp-sh-handle-file-name-all-completions) (file-name-as-directory . tramp-handle-file-name-as-directory) + (file-name-completion . tramp-handle-file-name-completion) (file-name-directory . tramp-handle-file-name-directory) (file-name-nondirectory . tramp-handle-file-name-nondirectory) - (file-truename . tramp-sh-handle-file-truename) - (file-exists-p . tramp-sh-handle-file-exists-p) - (file-accessible-directory-p . tramp-handle-file-accessible-directory-p) - (file-directory-p . tramp-sh-handle-file-directory-p) - (file-executable-p . tramp-sh-handle-file-executable-p) + ;; `file-name-sans-versions' performed by default handler. + (file-newer-than-file-p . tramp-sh-handle-file-newer-than-file-p) + (file-notify-add-watch . tramp-sh-handle-file-notify-add-watch) + (file-notify-rm-watch . tramp-handle-file-notify-rm-watch) + (file-ownership-preserved-p . tramp-sh-handle-file-ownership-preserved-p) (file-readable-p . tramp-sh-handle-file-readable-p) (file-regular-p . tramp-handle-file-regular-p) + (file-remote-p . tramp-handle-file-remote-p) + (file-selinux-context . tramp-sh-handle-file-selinux-context) (file-symlink-p . tramp-handle-file-symlink-p) + (file-truename . tramp-sh-handle-file-truename) (file-writable-p . tramp-sh-handle-file-writable-p) - (file-ownership-preserved-p . tramp-sh-handle-file-ownership-preserved-p) - (file-newer-than-file-p . tramp-sh-handle-file-newer-than-file-p) - (file-attributes . tramp-sh-handle-file-attributes) - (file-modes . tramp-handle-file-modes) - (directory-files . tramp-handle-directory-files) - (directory-files-and-attributes - . tramp-sh-handle-directory-files-and-attributes) - (file-name-all-completions . tramp-sh-handle-file-name-all-completions) - (file-name-completion . tramp-handle-file-name-completion) - (add-name-to-file . tramp-sh-handle-add-name-to-file) - (copy-file . tramp-sh-handle-copy-file) - (copy-directory . tramp-sh-handle-copy-directory) + (find-backup-file-name . tramp-handle-find-backup-file-name) + ;; `find-file-noselect' performed by default handler. + ;; `get-file-buffer' performed by default handler. + (insert-directory . tramp-sh-handle-insert-directory) + (insert-file-contents . tramp-handle-insert-file-contents) + (insert-file-contents-literally + . tramp-sh-handle-insert-file-contents-literally) + (load . tramp-handle-load) + (make-auto-save-file-name . tramp-sh-handle-make-auto-save-file-name) + (make-directory . tramp-sh-handle-make-directory) + (make-symbolic-link . tramp-sh-handle-make-symbolic-link) + (process-file . tramp-sh-handle-process-file) (rename-file . tramp-sh-handle-rename-file) + (set-file-acl . tramp-sh-handle-set-file-acl) (set-file-modes . tramp-sh-handle-set-file-modes) + (set-file-selinux-context . tramp-sh-handle-set-file-selinux-context) (set-file-times . tramp-sh-handle-set-file-times) - (make-directory . tramp-sh-handle-make-directory) - (delete-directory . tramp-sh-handle-delete-directory) - (delete-file . tramp-sh-handle-delete-file) - (directory-file-name . tramp-handle-directory-file-name) - ;; `executable-find' is not official yet. - (executable-find . tramp-sh-handle-executable-find) + (set-visited-file-modtime . tramp-sh-handle-set-visited-file-modtime) + (shell-command . tramp-handle-shell-command) (start-file-process . tramp-sh-handle-start-file-process) - (process-file . tramp-sh-handle-process-file) - (shell-command . tramp-handle-shell-command) - (insert-directory . tramp-sh-handle-insert-directory) - (expand-file-name . tramp-sh-handle-expand-file-name) (substitute-in-file-name . tramp-handle-substitute-in-file-name) - (file-local-copy . tramp-sh-handle-file-local-copy) - (file-remote-p . tramp-handle-file-remote-p) - (insert-file-contents . tramp-handle-insert-file-contents) - (insert-file-contents-literally - . tramp-sh-handle-insert-file-contents-literally) - (write-region . tramp-sh-handle-write-region) - (find-backup-file-name . tramp-handle-find-backup-file-name) - (make-auto-save-file-name . tramp-sh-handle-make-auto-save-file-name) (unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory) - (dired-compress-file . tramp-sh-handle-dired-compress-file) - (dired-recursive-delete-directory - . tramp-sh-handle-dired-recursive-delete-directory) - (dired-uncache . tramp-handle-dired-uncache) - (set-visited-file-modtime . tramp-sh-handle-set-visited-file-modtime) + (vc-registered . tramp-sh-handle-vc-registered) (verify-visited-file-modtime . tramp-sh-handle-verify-visited-file-modtime) - (file-selinux-context . tramp-sh-handle-file-selinux-context) - (set-file-selinux-context . tramp-sh-handle-set-file-selinux-context) - (file-acl . tramp-sh-handle-file-acl) - (set-file-acl . tramp-sh-handle-set-file-acl) - (vc-registered . tramp-sh-handle-vc-registered) - (file-notify-add-watch . tramp-sh-handle-file-notify-add-watch) - (file-notify-rm-watch . tramp-sh-handle-file-notify-rm-watch)) + (write-region . tramp-sh-handle-write-region)) "Alist of handler functions. Operations not mentioned here will be handled by the normal Emacs functions.") @@ -2284,9 +2289,7 @@ (tramp-get-method-parameter method 'tramp-copy-env)))) ;; Check for program. - (unless (let ((default-directory - (tramp-compat-temporary-file-directory))) - (executable-find copy-program)) + (unless (executable-find copy-program) (tramp-error v 'file-error "Cannot find copy program: %s" copy-program)) @@ -2667,11 +2670,6 @@ ;;; Remote commands: -(defun tramp-sh-handle-executable-find (command) - "Like `executable-find' for Tramp files." - (with-parsed-tramp-file-name default-directory nil - (tramp-find-executable v command (tramp-get-remote-path v) t))) - (defun tramp-process-sentinel (proc event) "Flush file caches." (unless (memq (process-status proc) '(run open)) @@ -3430,8 +3428,8 @@ (file-remote-p default-directory))) (rest-string (tramp-compat-process-get proc 'rest-string))) (when rest-string - (tramp-message proc 10 (format "Previous string:\n%s" rest-string))) - (tramp-message proc 6 (format "%S\n%s" proc string)) + (tramp-message proc 10 "Previous string:\n%s" rest-string)) + (tramp-message proc 6 "%S\n%s" proc string) (setq string (concat rest-string string) ;; Attribute change is returned in unused wording. string (replace-regexp-in-string @@ -3463,12 +3461,12 @@ ;; Save rest of the string. (when (zerop (length string)) (setq string nil)) - (when string (tramp-message proc 10 (format "Rest string:\n%s" string))) + (when string (tramp-message proc 10 "Rest string:\n%s" string)) (tramp-compat-process-put proc 'rest-string string))) (defun tramp-sh-file-inotifywait-process-filter (proc string) "Read output from \"inotifywait\" and add corresponding file-notify events." - (tramp-message proc 6 (format "%S\n%s" proc string)) + (tramp-message proc 6 "%S\n%s" proc string) (dolist (line (split-string string "[\n\r]+" 'omit-nulls)) ;; Check, whether there is a problem. (unless @@ -3492,15 +3490,6 @@ ;; once. Therefore, we apply the callback directly. (tramp-compat-funcall 'file-notify-callback object)))) -(defvar file-notify-descriptors) -(defun tramp-sh-handle-file-notify-rm-watch (proc) - "Like `file-notify-rm-watch' for Tramp files." - ;; The descriptor must be a process object. - (unless (and (processp proc) (gethash proc file-notify-descriptors)) - (tramp-error proc 'file-notify-error "Not a valid descriptor %S" proc)) - (tramp-message proc 6 (format "Kill %S" proc)) - (kill-process proc)) - ;;; Internal Functions: (defun tramp-maybe-send-script (vec script name) @@ -3618,7 +3607,7 @@ I.e., for each directory in `tramp-remote-path', it is tested whether it exists and if so, it is added to the environment variable PATH." - (tramp-message vec 5 (format "Setting $PATH environment variable")) + (tramp-message vec 5 "Setting $PATH environment variable") (tramp-send-command vec (format "PATH=%s; export PATH" (mapconcat 'identity (tramp-get-remote-path vec) ":")))) === modified file 'lisp/net/tramp-smb.el' --- lisp/net/tramp-smb.el 2013-07-24 13:29:15 +0000 +++ lisp/net/tramp-smb.el 2013-08-01 11:10:31 +0000 @@ -177,8 +177,7 @@ ;; New handlers should be added here. (defconst tramp-smb-file-name-handler-alist - '( - ;; `access-file' performed by default handler. + '(;; `access-file' performed by default handler. (add-name-to-file . tramp-smb-handle-add-name-to-file) ;; `byte-compiler-base-file-name' performed by default handler. (copy-directory . tramp-smb-handle-copy-directory) @@ -198,8 +197,10 @@ (file-acl . tramp-smb-handle-file-acl) (file-attributes . tramp-smb-handle-file-attributes) (file-directory-p . tramp-smb-handle-file-directory-p) + ;; `file-equal-p' performed by default handler. (file-executable-p . tramp-handle-file-exists-p) (file-exists-p . tramp-handle-file-exists-p) + ;; `file-in-directory-p' performed by default handler. (file-local-copy . tramp-smb-handle-file-local-copy) (file-modes . tramp-handle-file-modes) (file-name-all-completions . tramp-smb-handle-file-name-all-completions) @@ -210,7 +211,7 @@ ;; `file-name-sans-versions' performed by default handler. (file-newer-than-file-p . tramp-handle-file-newer-than-file-p) (file-notify-add-watch . tramp-handle-file-notify-add-watch) - (file-notify-rm-watch . ignore) + (file-notify-rm-watch . tramp-handle-file-notify-rm-watch) (file-ownership-preserved-p . ignore) (file-readable-p . tramp-handle-file-exists-p) (file-regular-p . tramp-handle-file-regular-p) @@ -225,6 +226,7 @@ (insert-directory . tramp-smb-handle-insert-directory) (insert-file-contents . tramp-handle-insert-file-contents) (load . tramp-handle-load) + ;; `make-auto-save-file-name' performed by default handler. (make-directory . tramp-smb-handle-make-directory) (make-directory-internal . tramp-smb-handle-make-directory-internal) (make-symbolic-link . tramp-smb-handle-make-symbolic-link) @@ -234,15 +236,14 @@ (set-file-modes . tramp-smb-handle-set-file-modes) (set-file-selinux-context . ignore) (set-file-times . ignore) - (set-visited-file-modtime . ignore) + (set-visited-file-modtime . tramp-handle-set-visited-file-modtime) (shell-command . tramp-handle-shell-command) (start-file-process . tramp-smb-handle-start-file-process) (substitute-in-file-name . tramp-smb-handle-substitute-in-file-name) (unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory) (vc-registered . ignore) - (verify-visited-file-modtime . ignore) - (write-region . tramp-smb-handle-write-region) -) + (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime) + (write-region . tramp-smb-handle-write-region)) "Alist of handler functions for Tramp SMB method. Operations not mentioned here will be handled by the default Emacs primitives.") @@ -1786,9 +1787,7 @@ (tramp-get-buffer vec) ;; Check for program. - (unless (let ((default-directory - (tramp-compat-temporary-file-directory))) - (executable-find tramp-smb-winexe-program)) + (unless (executable-find tramp-smb-winexe-program) (tramp-error vec 'file-error "Cannot find program: %s" tramp-smb-winexe-program)) === modified file 'lisp/net/tramp.el' --- lisp/net/tramp.el 2013-07-29 07:47:53 +0000 +++ lisp/net/tramp.el 2013-08-01 11:10:31 +0000 @@ -1975,11 +1975,11 @@ 'dired-compress-file 'dired-uncache 'file-accessible-directory-p 'file-attributes 'file-directory-p 'file-executable-p 'file-exists-p - 'file-local-copy 'file-remote-p 'file-modes + 'file-local-copy 'file-modes 'file-name-as-directory 'file-name-directory 'file-name-nondirectory 'file-name-sans-versions 'file-ownership-preserved-p 'file-readable-p - 'file-regular-p 'file-symlink-p 'file-truename + 'file-regular-p 'file-remote-p 'file-symlink-p 'file-truename 'file-writable-p 'find-backup-file-name 'find-file-noselect 'get-file-buffer 'insert-directory 'insert-file-contents 'load 'make-directory 'make-directory-internal @@ -2008,7 +2008,7 @@ ;; Emacs 23+ only. 'copy-directory ;; Emacs 24+ only. - 'file-in-directory-p 'file-equal-p + 'file-equal-p 'file-in-directory-p ;; XEmacs only. 'dired-make-relative-symlink 'vm-imap-move-mail 'vm-pop-move-mail 'vm-spool-move-mail)) @@ -3287,14 +3287,78 @@ ;; for backward compatibility. (expand-file-name "~/")) +(defun tramp-handle-set-visited-file-modtime (&optional time-list) + "Like `set-visited-file-modtime' for Tramp files." + (unless (buffer-file-name) + (error "Can't set-visited-file-modtime: buffer `%s' not visiting a file" + (buffer-name))) + (unless time-list + (let ((remote-file-name-inhibit-cache t)) + ;; '(-1 65535) means file doesn't exists yet. + (setq time-list + (or (nth 5 (file-attributes (buffer-file-name))) '(-1 65535))))) + ;; We use '(0 0) as a don't-know value. + (unless (equal time-list '(0 0)) + (tramp-run-real-handler 'set-visited-file-modtime (list time-list)))) + +(defun tramp-handle-verify-visited-file-modtime (&optional buf) + "Like `verify-visited-file-modtime' for Tramp files. +At the time `verify-visited-file-modtime' calls this function, we +already know that the buffer is visiting a file and that +`visited-file-modtime' does not return 0. Do not call this +function directly, unless those two cases are already taken care +of." + (with-current-buffer (or buf (current-buffer)) + (let ((f (buffer-file-name))) + ;; There is no file visiting the buffer, or the buffer has no + ;; recorded last modification time, or there is no established + ;; connection. + (if (or (not f) + (eq (visited-file-modtime) 0) + (not (tramp-file-name-handler 'file-remote-p f nil 'connected))) + t + (with-parsed-tramp-file-name f nil + (let* ((remote-file-name-inhibit-cache t) + (attr (file-attributes f)) + (modtime (nth 5 attr)) + (mt (visited-file-modtime))) + + (cond + ;; File exists, and has a known modtime. + ((and attr (not (equal modtime '(0 0)))) + (< (abs (tramp-time-diff + modtime + ;; For compatibility, deal with both the old + ;; (HIGH . LOW) and the new (HIGH LOW) return + ;; values of `visited-file-modtime'. + (if (atom (cdr mt)) + (list (car mt) (cdr mt)) + mt))) + 2)) + ;; Modtime has the don't know value. + (attr t) + ;; If file does not exist, say it is not modified if and + ;; only if that agrees with the buffer's record. + (t (equal mt '(-1 65535)))))))))) + (defun tramp-handle-file-notify-add-watch (filename flags callback) "Like `file-notify-add-watch' for Tramp files." - ;; This is the default handler. Some packages might have its own one. + ;; This is the default handler. tramp-gvfs.el and tramp-sh.el have + ;; its own one. (setq filename (expand-file-name filename)) (with-parsed-tramp-file-name filename nil (tramp-error v 'file-notify-error "File notification not supported for `%s'" filename))) +(defvar file-notify-descriptors) +(defun tramp-handle-file-notify-rm-watch (proc) + "Like `file-notify-rm-watch' for Tramp files." + ;; The descriptor must be a process object. + (unless (and (processp proc) (gethash proc file-notify-descriptors)) + (tramp-error proc 'file-notify-error "Not a valid descriptor %S" proc)) + (tramp-message proc 6 "Kill %S" proc) + (kill-process proc)) + ;;; Functions for establishing connection: ;; The following functions are actions to be taken when seeing certain @@ -3951,16 +4015,12 @@ defadvised `call-process' to behave like `process-file'. The Lisp error raised when PROGRAM is nil is trapped also, returning 1. Furthermore, traces are written with verbosity of 6." - (let ((default-directory - (if (file-remote-p default-directory) - (tramp-compat-temporary-file-directory) - default-directory))) - (tramp-message - (vector tramp-current-method tramp-current-user tramp-current-host nil nil) - 6 "%s %s %s" program infile args) - (if (executable-find program) - (apply 'call-process program infile destination display args) - 1))) + (tramp-message + (vector tramp-current-method tramp-current-user tramp-current-host nil nil) + 6 "%s %s %s" program infile args) + (if (executable-find program) + (apply 'call-process program infile destination display args) + 1)) ;;;###tramp-autoload (defun tramp-read-passwd (proc &optional prompt) ------------------------------------------------------------ revno: 113631 committer: Dmitry Antipov branch nick: trunk timestamp: Thu 2013-08-01 14:33:25 +0400 message: Avoid redundant Lisp_Object <-> struct frame conversions in font API. * font.h (struct font_driver): Change list, match, and list_family functions to accept struct frame * as first arg. * font.c (font_score, font_compare, font_sort_entities): Remove prototypes. (font_sort_entities, font_list_entities, font_select_entity): (font_find_for_lface, Flist_fonts, Ffont_family_list): Adjust to match font API change. * xfont.c (xfont_list, xfont_match, xfont_list_family): * ftfont.c (ftfont_list, ftfont_match, ftfont_list_family): * ftxfont.c (ftxfont_list, ftxfont_match): * xftfont.c (xftfont_list, xftfont_match): * nsfont.m (nsfont_list, nsfont_match, nsfont_list_family): * w32font.c (w32font_list, w32font_match, w32font_list): (w32font_list_internal, w32_font_match_internal): Likewise. * xfaces.c (Fx_family_fonts): Adjust user. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-08-01 07:33:58 +0000 +++ src/ChangeLog 2013-08-01 10:33:25 +0000 @@ -1,5 +1,24 @@ 2013-08-01 Dmitry Antipov + Avoid redundant Lisp_Object <-> struct frame conversions in font API. + * font.h (struct font_driver): Change list, match, and list_family + functions to accept struct frame * as first arg. + * font.c (font_score, font_compare, font_sort_entities): Remove + prototypes. + (font_sort_entities, font_list_entities, font_select_entity): + (font_find_for_lface, Flist_fonts, Ffont_family_list): Adjust to + match font API change. + * xfont.c (xfont_list, xfont_match, xfont_list_family): + * ftfont.c (ftfont_list, ftfont_match, ftfont_list_family): + * ftxfont.c (ftxfont_list, ftxfont_match): + * xftfont.c (xftfont_list, xftfont_match): + * nsfont.m (nsfont_list, nsfont_match, nsfont_list_family): + * w32font.c (w32font_list, w32font_match, w32font_list): + (w32font_list_internal, w32_font_match_internal): Likewise. + * xfaces.c (Fx_family_fonts): Adjust user. + +2013-08-01 Dmitry Antipov + Do not use pure Xism x_wm_set_icon_position in non-X ports. * frame.c (x_set_frame_parameters): Call to x_wm_set_icon_position only if HAVE_X_WINDOWS is in use. === modified file 'src/font.c' --- src/font.c 2013-07-19 01:24:35 +0000 +++ src/font.c 2013-08-01 10:33:25 +0000 @@ -2037,11 +2037,6 @@ /* Font sorting. */ -static unsigned font_score (Lisp_Object, Lisp_Object *); -static int font_compare (const void *, const void *); -static Lisp_Object font_sort_entities (Lisp_Object, Lisp_Object, - Lisp_Object, int); - static double font_rescale_ratio (Lisp_Object font_entity) { @@ -2186,14 +2181,14 @@ such a case. */ static Lisp_Object -font_sort_entities (Lisp_Object list, Lisp_Object prefer, Lisp_Object frame, int best_only) +font_sort_entities (Lisp_Object list, Lisp_Object prefer, + struct frame *f, int best_only) { Lisp_Object prefer_prop[FONT_SPEC_MAX]; int len, maxlen, i; struct font_sort_data *data; unsigned best_score; Lisp_Object best_entity; - struct frame *f = XFRAME (frame); Lisp_Object tail, vec IF_LINT (= Qnil); USE_SAFE_ALLOCA; @@ -2201,7 +2196,7 @@ prefer_prop[i] = AREF (prefer, i); if (FLOATP (prefer_prop[FONT_SIZE_INDEX])) prefer_prop[FONT_SIZE_INDEX] - = make_number (font_pixel_size (XFRAME (frame), prefer)); + = make_number (font_pixel_size (f, prefer)); if (NILP (XCDR (list))) { @@ -2692,9 +2687,8 @@ same font-driver. */ Lisp_Object -font_list_entities (Lisp_Object frame, Lisp_Object spec) +font_list_entities (struct frame *f, Lisp_Object spec) { - FRAME_PTR f = XFRAME (frame); struct font_driver_list *driver_list = f->font_driver_list; Lisp_Object ftype, val; Lisp_Object list = Qnil; @@ -2738,7 +2732,7 @@ { Lisp_Object copy; - val = driver_list->driver->list (frame, scratch_font_spec); + val = driver_list->driver->list (f, scratch_font_spec); if (NILP (val)) val = zero_vector; else @@ -2770,10 +2764,8 @@ { struct font_driver_list *driver_list = f->font_driver_list; Lisp_Object ftype, size, entity; - Lisp_Object frame; Lisp_Object work = copy_font_spec (spec); - XSETFRAME (frame, f); ftype = AREF (spec, FONT_TYPE_INDEX); size = AREF (spec, FONT_SIZE_INDEX); @@ -2797,7 +2789,7 @@ entity = XCDR (entity); else { - entity = driver_list->driver->match (frame, work); + entity = driver_list->driver->match (f, work); copy = copy_font_spec (work); ASET (copy, FONT_TYPE_INDEX, driver_list->driver->type); XSETCDR (cache, Fcons (Fcons (copy, entity), XCDR (cache))); @@ -3039,12 +3031,12 @@ supports C and is the best match for ATTRS and PIXEL_SIZE. */ static Lisp_Object -font_select_entity (Lisp_Object frame, Lisp_Object entities, Lisp_Object *attrs, int pixel_size, int c) +font_select_entity (struct frame *f, Lisp_Object entities, + Lisp_Object *attrs, int pixel_size, int c) { Lisp_Object font_entity; Lisp_Object prefer; int i; - FRAME_PTR f = XFRAME (frame); if (NILP (XCDR (entities)) && ASIZE (XCAR (entities)) == 1) @@ -3075,7 +3067,7 @@ FONT_SET_STYLE (prefer, FONT_WIDTH_INDEX, attrs[LFACE_SWIDTH_INDEX]); ASET (prefer, FONT_SIZE_INDEX, make_number (pixel_size)); - return font_sort_entities (entities, prefer, frame, c); + return font_sort_entities (entities, prefer, f, c); } /* Return a font-entity that satisfies SPEC and is the best match for @@ -3086,7 +3078,7 @@ font_find_for_lface (FRAME_PTR f, Lisp_Object *attrs, Lisp_Object spec, int c) { Lisp_Object work; - Lisp_Object frame, entities, val; + Lisp_Object entities, val; Lisp_Object foundry[3], *family, registry[3], adstyle[3]; int pixel_size; int i, j, k, l; @@ -3118,7 +3110,6 @@ work = copy_font_spec (spec); ASET (work, FONT_TYPE_INDEX, AREF (spec, FONT_TYPE_INDEX)); - XSETFRAME (frame, f); pixel_size = font_pixel_size (f, spec); if (pixel_size == 0 && INTEGERP (attrs[LFACE_HEIGHT_INDEX])) { @@ -3212,10 +3203,10 @@ for (l = 0; SYMBOLP (adstyle[l]); l++) { ASET (work, FONT_ADSTYLE_INDEX, adstyle[l]); - entities = font_list_entities (frame, work); + entities = font_list_entities (f, work); if (! NILP (entities)) { - val = font_select_entity (frame, entities, + val = font_select_entity (f, entities, attrs, pixel_size, c); if (! NILP (val)) return val; @@ -4110,12 +4101,10 @@ how close they are to PREFER. */) (Lisp_Object font_spec, Lisp_Object frame, Lisp_Object num, Lisp_Object prefer) { + struct frame *f = decode_live_frame (frame); Lisp_Object vec, list; EMACS_INT n = 0; - if (NILP (frame)) - frame = selected_frame; - CHECK_LIVE_FRAME (frame); CHECK_FONT_SPEC (font_spec); if (! NILP (num)) { @@ -4127,7 +4116,7 @@ if (! NILP (prefer)) CHECK_FONT_SPEC (prefer); - list = font_list_entities (frame, font_spec); + list = font_list_entities (f, font_spec); if (NILP (list)) return Qnil; if (NILP (XCDR (list)) @@ -4135,7 +4124,7 @@ return list1 (AREF (XCAR (list), 0)); if (! NILP (prefer)) - vec = font_sort_entities (list, prefer, frame, 0); + vec = font_sort_entities (list, prefer, f, 0); else vec = font_vconcat_entity_vectors (list); if (n == 0 || n >= ASIZE (vec)) @@ -4163,13 +4152,11 @@ struct font_driver_list *driver_list; Lisp_Object list = Qnil; - XSETFRAME (frame, f); - for (driver_list = f->font_driver_list; driver_list; driver_list = driver_list->next) if (driver_list->driver->list_family) { - Lisp_Object val = driver_list->driver->list_family (frame); + Lisp_Object val = driver_list->driver->list_family (f); Lisp_Object tail = list; for (; CONSP (val); val = XCDR (val)) === modified file 'src/font.h' --- src/font.h 2013-02-13 07:14:38 +0000 +++ src/font.h 2013-08-01 10:33:25 +0000 @@ -527,7 +527,7 @@ This and the following `match' are the only APIs that allocate font-entities. */ - Lisp_Object (*list) (Lisp_Object frame, Lisp_Object font_spec); + Lisp_Object (*list) (struct frame *frame, Lisp_Object font_spec); /* Return a font-entity most closely matching with FONT_SPEC on FRAME. Which font property to consider, and how to calculate the @@ -536,12 +536,12 @@ The properties that the font-entity has is the same as `list' method. */ - Lisp_Object (*match) (Lisp_Object frame, Lisp_Object font_spec); + Lisp_Object (*match) (struct frame *f, Lisp_Object spec); /* Optional. List available families. The value is a list of family names (symbols). */ - Lisp_Object (*list_family) (Lisp_Object frame); + Lisp_Object (*list_family) (struct frame *f); /* Optional (if FONT_EXTRA_INDEX is not Lisp_Save_Value). Free FONT_EXTRA_INDEX field of FONT_ENTITY. */ @@ -742,8 +742,7 @@ bool for_face); extern bool font_match_p (Lisp_Object spec, Lisp_Object font); -extern Lisp_Object font_list_entities (Lisp_Object frame, - Lisp_Object spec); +extern Lisp_Object font_list_entities (struct frame *, Lisp_Object); extern Lisp_Object font_get_name (Lisp_Object font_object); extern Lisp_Object font_spec_from_name (Lisp_Object font_name); === modified file 'src/ftfont.c' --- src/ftfont.c 2013-07-19 01:24:35 +0000 +++ src/ftfont.c 2013-08-01 10:33:25 +0000 @@ -494,9 +494,9 @@ #endif /* HAVE_LIBOTF */ static Lisp_Object ftfont_get_cache (FRAME_PTR); -static Lisp_Object ftfont_list (Lisp_Object, Lisp_Object); -static Lisp_Object ftfont_match (Lisp_Object, Lisp_Object); -static Lisp_Object ftfont_list_family (Lisp_Object); +static Lisp_Object ftfont_list (struct frame *, Lisp_Object); +static Lisp_Object ftfont_match (struct frame *, Lisp_Object); +static Lisp_Object ftfont_list_family (struct frame *); static Lisp_Object ftfont_open (FRAME_PTR, Lisp_Object, int); static void ftfont_close (FRAME_PTR, struct font *); static int ftfont_has_char (Lisp_Object, int); @@ -884,7 +884,7 @@ } static Lisp_Object -ftfont_list (Lisp_Object frame, Lisp_Object spec) +ftfont_list (struct frame *f, Lisp_Object spec) { Lisp_Object val = Qnil, family, adstyle; int i; @@ -1080,7 +1080,7 @@ } static Lisp_Object -ftfont_match (Lisp_Object frame, Lisp_Object spec) +ftfont_match (struct frame *f, Lisp_Object spec) { Lisp_Object entity = Qnil; FcPattern *pattern, *match = NULL; @@ -1130,7 +1130,7 @@ } static Lisp_Object -ftfont_list_family (Lisp_Object frame) +ftfont_list_family (struct frame *f) { Lisp_Object list = Qnil; FcPattern *pattern = NULL; === modified file 'src/ftxfont.c' --- src/ftxfont.c 2013-01-01 09:11:05 +0000 +++ src/ftxfont.c 2013-08-01 10:33:25 +0000 @@ -226,9 +226,9 @@ } static Lisp_Object -ftxfont_list (Lisp_Object frame, Lisp_Object spec) +ftxfont_list (struct frame *f, Lisp_Object spec) { - Lisp_Object list = ftfont_driver.list (frame, spec), tail; + Lisp_Object list = ftfont_driver.list (f, spec), tail; for (tail = list; CONSP (tail); tail = XCDR (tail)) ASET (XCAR (tail), FONT_TYPE_INDEX, Qftx); @@ -236,9 +236,9 @@ } static Lisp_Object -ftxfont_match (Lisp_Object frame, Lisp_Object spec) +ftxfont_match (struct frame *f, Lisp_Object spec) { - Lisp_Object entity = ftfont_driver.match (frame, spec); + Lisp_Object entity = ftfont_driver.match (f, spec); if (VECTORP (entity)) ASET (entity, FONT_TYPE_INDEX, Qftx); === modified file 'src/nsfont.m' --- src/nsfont.m 2013-07-16 06:39:49 +0000 +++ src/nsfont.m 2013-08-01 10:33:25 +0000 @@ -620,9 +620,9 @@ static Lisp_Object nsfont_get_cache (FRAME_PTR frame); -static Lisp_Object nsfont_list (Lisp_Object frame, Lisp_Object font_spec); -static Lisp_Object nsfont_match (Lisp_Object frame, Lisp_Object font_spec); -static Lisp_Object nsfont_list_family (Lisp_Object frame); +static Lisp_Object nsfont_list (struct frame *, Lisp_Object); +static Lisp_Object nsfont_match (struct frame *, Lisp_Object); +static Lisp_Object nsfont_list_family (struct frame *); static Lisp_Object nsfont_open (FRAME_PTR f, Lisp_Object font_entity, int pixel_size); static void nsfont_close (FRAME_PTR f, struct font *font); @@ -679,9 +679,9 @@ weight, slant, width, size (0 if scalable), dpi, spacing, avgwidth (0 if scalable) */ static Lisp_Object -nsfont_list (Lisp_Object frame, Lisp_Object font_spec) +nsfont_list (struct frame *f, Lisp_Object font_spec) { - return ns_findfonts (font_spec, NO); + return ns_findfonts (font_spec, NO); } @@ -690,16 +690,16 @@ `face-font-selection-order' is ignored here. Properties to be considered are same as for list(). */ static Lisp_Object -nsfont_match (Lisp_Object frame, Lisp_Object font_spec) +nsfont_match (struct frame *f, Lisp_Object font_spec) { - return ns_findfonts(font_spec, YES); + return ns_findfonts (font_spec, YES); } /* List available families. The value is a list of family names (symbols). */ static Lisp_Object -nsfont_list_family (Lisp_Object frame) +nsfont_list_family (struct frame *f) { Lisp_Object list = Qnil; NSEnumerator *families; === modified file 'src/w32font.c' --- src/w32font.c 2013-04-07 04:41:19 +0000 +++ src/w32font.c 2013-08-01 10:33:25 +0000 @@ -309,9 +309,9 @@ is a vector of font-entities. This is the sole API that allocates font-entities. */ static Lisp_Object -w32font_list (Lisp_Object frame, Lisp_Object font_spec) +w32font_list (struct frame *f, Lisp_Object font_spec) { - Lisp_Object fonts = w32font_list_internal (frame, font_spec, 0); + Lisp_Object fonts = w32font_list_internal (f, font_spec, 0); FONT_ADD_LOG ("w32font-list", font_spec, fonts); return fonts; } @@ -321,9 +321,9 @@ FRAME. The closeness is determined by the font backend, thus `face-font-selection-order' is ignored here. */ static Lisp_Object -w32font_match (Lisp_Object frame, Lisp_Object font_spec) +w32font_match (struct frame *f, Lisp_Object font_spec) { - Lisp_Object entity = w32font_match_internal (frame, font_spec, 0); + Lisp_Object entity = w32font_match_internal (f, font_spec, 0); FONT_ADD_LOG ("w32font-match", font_spec, entity); return entity; } @@ -332,12 +332,11 @@ List available families. The value is a list of family names (symbols). */ static Lisp_Object -w32font_list_family (Lisp_Object frame) +w32font_list_family (struct frame *f) { Lisp_Object list = Qnil; LOGFONT font_match_pattern; HDC dc; - FRAME_PTR f = XFRAME (frame); memset (&font_match_pattern, 0, sizeof (font_match_pattern)); font_match_pattern.lfCharSet = DEFAULT_CHARSET; @@ -811,15 +810,14 @@ Additional parameter opentype_only restricts the returned fonts to opentype fonts, which can be used with the Uniscribe backend. */ Lisp_Object -w32font_list_internal (Lisp_Object frame, Lisp_Object font_spec, int opentype_only) +w32font_list_internal (struct frame *f, Lisp_Object font_spec, int opentype_only) { struct font_callback_data match_data; HDC dc; - FRAME_PTR f = XFRAME (frame); match_data.orig_font_spec = font_spec; match_data.list = Qnil; - match_data.frame = frame; + XSETFRAME (match_data.frame, f); memset (&match_data.pattern, 0, sizeof (LOGFONT)); fill_in_logfont (f, &match_data.pattern, font_spec); @@ -864,14 +862,13 @@ Additional parameter opentype_only restricts the returned fonts to opentype fonts, which can be used with the Uniscribe backend. */ Lisp_Object -w32font_match_internal (Lisp_Object frame, Lisp_Object font_spec, int opentype_only) +w32font_match_internal (struct frame *f, Lisp_Object font_spec, int opentype_only) { struct font_callback_data match_data; HDC dc; - FRAME_PTR f = XFRAME (frame); match_data.orig_font_spec = font_spec; - match_data.frame = frame; + XSETFRAME (match_data.frame, f); match_data.list = Qnil; memset (&match_data.pattern, 0, sizeof (LOGFONT)); @@ -2114,7 +2111,7 @@ list_all_matching_fonts (struct font_callback_data *match_data) { HDC dc; - Lisp_Object families = w32font_list_family (match_data->frame); + Lisp_Object families = w32font_list_family (XFRAME (match_data->frame)); struct frame *f = XFRAME (match_data->frame); dc = get_frame_dc (f); === modified file 'src/xfaces.c' --- src/xfaces.c 2013-07-30 13:40:46 +0000 +++ src/xfaces.c 2013-08-01 10:33:25 +0000 @@ -1530,15 +1530,12 @@ (Lisp_Object family, Lisp_Object frame) { Lisp_Object font_spec, list, *drivers, vec; + struct frame *f = decode_live_frame (frame); ptrdiff_t i, nfonts; EMACS_INT ndrivers; Lisp_Object result; USE_SAFE_ALLOCA; - if (NILP (frame)) - frame = selected_frame; - CHECK_LIVE_FRAME (frame); - font_spec = Ffont_spec (0, NULL); if (!NILP (family)) { @@ -1546,7 +1543,7 @@ font_parse_family_registry (family, Qnil, font_spec); } - list = font_list_entities (frame, font_spec); + list = font_list_entities (f, font_spec); if (NILP (list)) return Qnil; @@ -1589,7 +1586,7 @@ ASET (v, 0, AREF (font, FONT_FAMILY_INDEX)); ASET (v, 1, FONT_WIDTH_SYMBOLIC (font)); point = PIXEL_TO_POINT (XINT (AREF (font, FONT_SIZE_INDEX)) * 10, - FRAME_RES_Y (XFRAME (frame))); + FRAME_RES_Y (f)); ASET (v, 2, make_number (point)); ASET (v, 3, FONT_WEIGHT_SYMBOLIC (font)); ASET (v, 4, FONT_SLANT_SYMBOLIC (font)); === modified file 'src/xfont.c' --- src/xfont.c 2013-07-16 06:39:49 +0000 +++ src/xfont.c 2013-08-01 10:33:25 +0000 @@ -115,9 +115,9 @@ } static Lisp_Object xfont_get_cache (FRAME_PTR); -static Lisp_Object xfont_list (Lisp_Object, Lisp_Object); -static Lisp_Object xfont_match (Lisp_Object, Lisp_Object); -static Lisp_Object xfont_list_family (Lisp_Object); +static Lisp_Object xfont_list (struct frame *, Lisp_Object); +static Lisp_Object xfont_match (struct frame *, Lisp_Object); +static Lisp_Object xfont_list_family (struct frame *); static Lisp_Object xfont_open (FRAME_PTR, Lisp_Object, int); static void xfont_close (FRAME_PTR, struct font *); static int xfont_prepare_face (FRAME_PTR, struct face *); @@ -486,9 +486,8 @@ } static Lisp_Object -xfont_list (Lisp_Object frame, Lisp_Object spec) +xfont_list (struct frame *f, Lisp_Object spec) { - FRAME_PTR f = XFRAME (frame); Display *display = FRAME_X_DISPLAY_INFO (f)->display; Lisp_Object registry, list, val, extra, script; int len; @@ -565,9 +564,8 @@ } static Lisp_Object -xfont_match (Lisp_Object frame, Lisp_Object spec) +xfont_match (struct frame *f, Lisp_Object spec) { - FRAME_PTR f = XFRAME (frame); Display *display = FRAME_X_DISPLAY_INFO (f)->display; Lisp_Object extra, val, entity; char name[512]; @@ -622,9 +620,8 @@ } static Lisp_Object -xfont_list_family (Lisp_Object frame) +xfont_list_family (struct frame *f) { - FRAME_PTR f = XFRAME (frame); Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f); char **names; int num_fonts, i; === modified file 'src/xftfont.c' --- src/xftfont.c 2013-01-02 16:13:04 +0000 +++ src/xftfont.c 2013-08-01 10:33:25 +0000 @@ -139,9 +139,9 @@ struct font_driver xftfont_driver; static Lisp_Object -xftfont_list (Lisp_Object frame, Lisp_Object spec) +xftfont_list (struct frame *f, Lisp_Object spec) { - Lisp_Object list = ftfont_driver.list (frame, spec), tail; + Lisp_Object list = ftfont_driver.list (f, spec), tail; for (tail = list; CONSP (tail); tail = XCDR (tail)) ASET (XCAR (tail), FONT_TYPE_INDEX, Qxft); @@ -149,9 +149,9 @@ } static Lisp_Object -xftfont_match (Lisp_Object frame, Lisp_Object spec) +xftfont_match (struct frame *f, Lisp_Object spec) { - Lisp_Object entity = ftfont_driver.match (frame, spec); + Lisp_Object entity = ftfont_driver.match (f, spec); if (! NILP (entity)) ASET (entity, FONT_TYPE_INDEX, Qxft); ------------------------------------------------------------ revno: 113630 committer: Dmitry Antipov branch nick: trunk timestamp: Thu 2013-08-01 11:33:58 +0400 message: * xterm.c (any_help_event_p, x_draw_glyph_string_background): (x_display_ok): Use bool for booleans. (x_draw_glyph_string_background, cvt_string_to_pixel): (cvt_pixel_dtor): Drop unnecessary prototypes. * xterm.h (x_display_ok): Adjust prototype. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-08-01 06:38:49 +0000 +++ src/ChangeLog 2013-08-01 07:33:58 +0000 @@ -17,6 +17,11 @@ This is better because this code always unconditionally skips non-X frames in Vframe_list and issues the only XFlush if we have more than one X frame on the same X display. + (any_help_event_p, x_draw_glyph_string_background, x_display_ok): + Use bool for booleans. + (x_draw_glyph_string_background, cvt_string_to_pixel): + (cvt_pixel_dtor): Drop unnecessary prototypes. + * xterm.h (x_display_ok): Adjust prototype. 2013-07-31 Dmitry Antipov === modified file 'src/xterm.c' --- src/xterm.c 2013-08-01 05:56:20 +0000 +++ src/xterm.c 2013-08-01 07:33:58 +0000 @@ -145,7 +145,7 @@ /* Non-zero means that a HELP_EVENT has been generated since Emacs start. */ -static int any_help_event_p; +static bool any_help_event_p; /* Last window where we saw the mouse. Used by mouse-autoselect-window. */ static Lisp_Object last_window; @@ -877,8 +877,6 @@ static void x_set_glyph_string_clipping (struct glyph_string *); static void x_set_glyph_string_gc (struct glyph_string *); -static void x_draw_glyph_string_background (struct glyph_string *, - int); static void x_draw_glyph_string_foreground (struct glyph_string *); static void x_draw_composite_glyph_string_foreground (struct glyph_string *); static void x_draw_glyph_string_box (struct glyph_string *); @@ -1163,7 +1161,7 @@ contains the first component of a composition. */ static void -x_draw_glyph_string_background (struct glyph_string *s, int force_p) +x_draw_glyph_string_background (struct glyph_string *s, bool force_p) { /* Nothing to do if background has already been drawn or if it shouldn't be drawn in the first place. */ @@ -1413,11 +1411,6 @@ #ifdef USE_X_TOOLKIT -static Boolean cvt_string_to_pixel (Display *, XrmValue *, Cardinal *, - XrmValue *, XrmValue *, XtPointer *); -static void cvt_pixel_dtor (XtAppContext, XrmValue *, XtPointer, - XrmValue *, Cardinal *); - #ifdef USE_LUCID /* Return the frame on which widget WIDGET is used.. Abort if frame @@ -9811,18 +9804,11 @@ /* Return 1 if display DISPLAY is available for use, 0 otherwise. But don't permanently open it, just test its availability. */ -int +bool x_display_ok (const char *display) { - int dpy_ok = 1; - Display *dpy; - - dpy = XOpenDisplay (display); - if (dpy) - XCloseDisplay (dpy); - else - dpy_ok = 0; - return dpy_ok; + Display *dpy = XOpenDisplay (display); + return dpy ? (XCloseDisplay (dpy), 1) : 0; } #ifdef USE_GTK === modified file 'src/xterm.h' --- src/xterm.h 2013-07-31 12:50:59 +0000 +++ src/xterm.h 2013-08-01 07:33:58 +0000 @@ -403,7 +403,7 @@ extern struct x_display_info *x_display_info_for_display (Display *); extern struct x_display_info *x_term_init (Lisp_Object, char *, char *); -extern int x_display_ok (const char *); +extern bool x_display_ok (const char *); extern void select_visual (struct x_display_info *); ------------------------------------------------------------ revno: 113629 committer: Dmitry Antipov branch nick: trunk timestamp: Thu 2013-08-01 10:38:49 +0400 message: Do not use pure Xism x_wm_set_icon_position in non-X ports. * frame.c (x_set_frame_parameters): Call to x_wm_set_icon_position only if HAVE_X_WINDOWS is in use. * frame.h (x_set_frame_parameters): Move under HAVE_X_WINDOWS. * nsterm.m (x_wm_set_icon_position): Remove no-op. * w32term.c (x_wm_set_icon_position): Likewise. * w32fns.c (x_icon): Adjust user. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-08-01 05:56:20 +0000 +++ src/ChangeLog 2013-08-01 06:38:49 +0000 @@ -1,5 +1,15 @@ 2013-08-01 Dmitry Antipov + Do not use pure Xism x_wm_set_icon_position in non-X ports. + * frame.c (x_set_frame_parameters): Call to x_wm_set_icon_position + only if HAVE_X_WINDOWS is in use. + * frame.h (x_set_frame_parameters): Move under HAVE_X_WINDOWS. + * nsterm.m (x_wm_set_icon_position): Remove no-op. + * w32term.c (x_wm_set_icon_position): Likewise. + * w32fns.c (x_icon): Adjust user. + +2013-08-01 Dmitry Antipov + * xterm.c (last_mouse_press_frame): Remove the leftover which is not really used any more. (handle_one_xevent, syms_of_xterm): Adjust users. === modified file 'src/frame.c' --- src/frame.c 2013-07-31 12:50:59 +0000 +++ src/frame.c 2013-08-01 06:38:49 +0000 @@ -2867,10 +2867,11 @@ /* Actually set that position, and convert to absolute. */ x_set_offset (f, leftpos, toppos, -1); } - +#ifdef HAVE_X_WINDOWS if ((!NILP (icon_left) || !NILP (icon_top)) && ! (icon_left_no_change && icon_top_no_change)) x_wm_set_icon_position (f, XINT (icon_left), XINT (icon_top)); +#endif /* HAVE_X_WINDOWS */ } UNGCPRO; === modified file 'src/frame.h' --- src/frame.h 2013-07-31 12:50:59 +0000 +++ src/frame.h 2013-08-01 06:38:49 +0000 @@ -1207,7 +1207,6 @@ extern void x_set_scroll_bar_default_width (struct frame *); extern void x_set_offset (struct frame *, int, int, int); -extern void x_wm_set_icon_position (struct frame *, int, int); extern void x_wm_set_size_hint (FRAME_PTR f, long flags, bool user_position); extern Lisp_Object x_new_font (struct frame *, Lisp_Object, int); @@ -1278,9 +1277,12 @@ extern void free_frame_menubar (struct frame *); extern void x_free_frame_resources (struct frame *); -#if defined HAVE_X_WINDOWS && !defined USE_X_TOOLKIT +#if defined HAVE_X_WINDOWS +extern void x_wm_set_icon_position (struct frame *, int, int); +#if !defined USE_X_TOOLKIT extern char *x_get_resource_string (const char *, const char *); #endif +#endif extern void x_query_colors (struct frame *f, XColor *, int); extern void x_query_color (struct frame *f, XColor *); === modified file 'src/nsterm.m' --- src/nsterm.m 2013-07-27 22:14:07 +0000 +++ src/nsterm.m 2013-08-01 06:38:49 +0000 @@ -3863,15 +3863,6 @@ [eview updateFrameSize: NO]; } - -void -x_wm_set_icon_position (struct frame *f, int icon_x, int icon_y) -{ - /* XXX irrelevant under NS */ -} - - - /* ========================================================================== Initialization === modified file 'src/w32fns.c' --- src/w32fns.c 2013-07-31 12:50:59 +0000 +++ src/w32fns.c 2013-08-01 06:38:49 +0000 @@ -4182,9 +4182,6 @@ block_input (); - if (! EQ (icon_x, Qunbound)) - x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y)); - #if 0 /* TODO */ /* Start up iconic or window? */ x_wm_set_window_state === modified file 'src/w32term.c' --- src/w32term.c 2013-07-30 05:56:18 +0000 +++ src/w32term.c 2013-08-01 06:38:49 +0000 @@ -6225,22 +6225,6 @@ leave_crit (); } -/* Window manager things */ -void -x_wm_set_icon_position (struct frame *f, int icon_x, int icon_y) -{ -#if 0 - Window window = FRAME_W32_WINDOW (f); - - f->display.x->wm_hints.flags |= IconPositionHint; - f->display.x->wm_hints.icon_x = icon_x; - f->display.x->wm_hints.icon_y = icon_y; - - XSetWMHints (FRAME_X_DISPLAY (f), window, &f->display.x->wm_hints); -#endif -} - - /*********************************************************************** Fonts ***********************************************************************/