------------------------------------------------------------ revno: 118229 committer: Paul Eggert branch nick: trunk timestamp: Tue 2014-10-28 20:21:06 -0700 message: Port current-time change to XEmacs 21.4. See the buildbot log at: http://www.randomsample.de:4456/builders/xemacs21.4-linux/builds/1285 * lisp/erc/erc.el (erc-emacs-time-to-erc-time) (erc-emacs-time-to-erc-time): * lisp/gnus/gnus-util.el (gnus-float-time): * lisp/org/org-compat.el (org-float-time): Use 2-arg defalias, since XEmacs 21.4 doesn't support 3-arg. diff: === modified file 'lisp/erc/erc.el' --- lisp/erc/erc.el 2014-10-29 01:42:51 +0000 +++ lisp/erc/erc.el 2014-10-29 03:21:06 +0000 @@ -5957,14 +5957,9 @@ (truncate (mod n 65536))))) (defalias 'erc-emacs-time-to-erc-time - (if (featurep 'xemacs) 'time-to-seconds 'float-time) - "Convert time value TIME to a floating point number. -TIME defaults to the current time.") - -(defalias 'erc-current-time 'erc-emacs-time-to-erc-time - "Return the `current-time' as a number of seconds since the epoch. - -See also `erc-emacs-time-to-erc-time'.") + (if (featurep 'xemacs) 'time-to-seconds 'float-time)) + +(defalias 'erc-current-time 'erc-emacs-time-to-erc-time) (defun erc-time-diff (t1 t2) "Return the time difference in seconds between T1 and T2." === modified file 'lisp/gnus/gnus-util.el' --- lisp/gnus/gnus-util.el 2014-10-29 01:42:51 +0000 +++ lisp/gnus/gnus-util.el 2014-10-29 03:21:06 +0000 @@ -316,9 +316,7 @@ (defalias 'gnus-float-time (if (or (featurep 'emacs) (fboundp 'float-time)) - 'float-time 'time-to-seconds) - "Convert time value TIME to a floating point number. -TIME defaults to the current time.") + 'float-time 'time-to-seconds)) ;;; Keymap macros. === modified file 'lisp/org/org-compat.el' --- lisp/org/org-compat.el 2014-10-29 01:42:51 +0000 +++ lisp/org/org-compat.el 2014-10-29 03:21:06 +0000 @@ -412,9 +412,7 @@ (set-mouse-position frame (1- (frame-width frame)) 0))))) (defalias 'org-float-time - (if (featurep 'xemacs) 'time-to-seconds 'float-time) - "Convert time value TIME to a floating point number. -TIME defaults to the current time.") + (if (featurep 'xemacs) 'time-to-seconds 'float-time)) ;; `user-error' is only available from 24.2.50 on (unless (fboundp 'user-error) ------------------------------------------------------------ revno: 118228 committer: Paul Eggert branch nick: trunk timestamp: Tue 2014-10-28 18:42:51 -0700 message: Simplify use of current-time and friends. * doc/misc/org.texi (Dynamic blocks): * lisp/allout-widgets.el (allout-widgets-hook-error-handler): * lisp/calendar/appt.el (appt-display-message): * lisp/calendar/icalendar.el (icalendar--convert-float-to-ical): * lisp/calendar/timeclock.el (timeclock-in, timeclock-when-to-leave) (timeclock-last-period, timeclock-day-base): * lisp/eshell/em-ls.el (eshell-ls-file): * lisp/eshell/esh-util.el (eshell-parse-ange-ls): * lisp/generic-x.el (named-database-print-serial): * lisp/net/newst-backend.el (newsticker--get-news-by-url-callback) (newsticker-get-news, newsticker--sentinel-work) (newsticker--image-get, newsticker--image-sentinel): * lisp/net/tramp-sh.el (tramp-get-remote-touch): * lisp/progmodes/opascal.el (opascal-debug-log): * lisp/textmodes/remember.el (remember-mail-date) (remember-store-in-files): * lisp/vc/vc-annotate.el (vc-annotate-display-autoscale) (vc-default-annotate-current-time): * lisp/vc/vc-bzr.el (vc-bzr-shelve-snapshot): * lisp/vc/vc-cvs.el (vc-cvs-annotate-current-time): * lisp/vc/vc-rcs.el (vc-rcs-annotate-current-time): * lisp/url/url-util.el (url-get-normalized-date): * lisp/erc/erc-backend.el (TOPIC): * lisp/gnus/gnus-delay.el (gnus-delay-article): * lisp/gnus/gnus-sum.el (gnus-summary-read-document): * lisp/gnus/gnus-util.el (gnus-seconds-today, gnus-seconds-month): * lisp/gnus/message.el (message-make-expires-date): * lisp/org/org-archive.el (org-archive-subtree) (org-archive-to-archive-sibling): * lisp/org/org-clock.el (org-resolve-clocks, org-clock-get-sum-start) (org-clock-special-range): * lisp/org/org-timer.el (org-timer-seconds): * lisp/org/org.el (org-read-date-analyze, org-get-cursor-date): * lisp/org/ox-html.el (org-html-format-spec): * lisp/org/ox-icalendar.el (org-icalendar--vtodo): Omit unnecessary call to current-time. * lisp/calendar/time-date.el (time-to-seconds) [!float-time]: * lisp/calendar/timeclock.el (timeclock-time-to-date): * lisp/vc/vc-annotate.el (vc-annotate-convert-time): Use current time if arg is nil, to be compatible with float-time. (time-date--day-in-year): New function, with most of the guts of the old time-to-day-in-year. (time-to-day-in-year): Use it. (time-to-days): Use it, to avoid decoding the same time stamp twice. * lisp/calendar/timeclock.el (timeclock-update-mode-line): * lisp/cedet/srecode/args.el (srecode-semantic-handle-:time): * lisp/gnus/gnus-util.el (gnus-seconds-year): * lisp/org/org.el (org-get-cursor-date): Don't call current-time twice to get the current time stamp, as this can lead to inconsistent results. * lisp/completion.el (cmpl-hours-since-origin): * lisp/erc/erc.el (erc-emacs-time-to-erc-time): * lisp/ido.el (ido-time-stamp): * lisp/vc/vc-annotate.el (vc-annotate-convert-time): Simplify by using float-time. * lisp/completion.el (save-completions-to-file): * lisp/url/url-cache.el (url-cache-prune-cache): Rename local var to avoid confusion. * lisp/gnus/gnus-util.el (gnus-float-time): * lisp/net/rcirc.el (rcirc-float-time): * lisp/org/org-compat.el (org-float-time): Simplify to an alias because time-to-seconds now behaves like float-time with respect to nil arg. * lisp/subr.el (progress-reporter-do-update): Don't call float-time unless needed. * lisp/erc/erc.el (erc-current-time): Simplify by using erc-emacs-time-to-erc-time. * lisp/org/org-clock.el (org-clock-get-table-data): Omit unnecessary, lossy conversion from floating point to Emacs time and back. (org-resolve-clocks): Prefer two-argument floor. diff: === modified file 'doc/misc/ChangeLog' --- doc/misc/ChangeLog 2014-10-29 00:37:37 +0000 +++ doc/misc/ChangeLog 2014-10-29 01:42:51 +0000 @@ -1,3 +1,9 @@ +2014-10-29 Paul Eggert + + Simplify use of current-time and friends. + * org.texi (Dynamic blocks): Omit unnecessary call to current-time + in example. + 2014-10-28 Christopher Schmidt * calc.texi (Quick Calculator): Mention prefix argument of === modified file 'doc/misc/org.texi' --- doc/misc/org.texi 2014-10-12 22:56:45 +0000 +++ doc/misc/org.texi 2014-10-29 01:42:51 +0000 @@ -13126,7 +13126,7 @@ #+TEXINFO_PRINTED_TITLE: GNU Sample #+SUBTITLE: for version 2.0, last updated 4 March 2014 -* Copying +* Copying :PROPERTIES: :COPYING: t :END: @@ -17538,7 +17538,7 @@ (defun org-dblock-write:block-update-time (params) (let ((fmt (or (plist-get params :format) "%d. %m. %Y"))) (insert "Last block update at: " - (format-time-string fmt (current-time))))) + (format-time-string fmt)))) @end lisp If you want to make sure that all dynamic blocks are always up-to-date, === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-10-29 01:37:16 +0000 +++ lisp/ChangeLog 2014-10-29 01:42:51 +0000 @@ -1,3 +1,50 @@ +2014-10-29 Paul Eggert + + Simplify use of current-time and friends. + * allout-widgets.el (allout-widgets-hook-error-handler): + * calendar/appt.el (appt-display-message): + * calendar/icalendar.el (icalendar--convert-float-to-ical): + * calendar/timeclock.el (timeclock-in, timeclock-when-to-leave) + (timeclock-last-period, timeclock-day-base): + * eshell/em-ls.el (eshell-ls-file): + * eshell/esh-util.el (eshell-parse-ange-ls): + * generic-x.el (named-database-print-serial): + * net/newst-backend.el (newsticker--get-news-by-url-callback) + (newsticker-get-news, newsticker--sentinel-work) + (newsticker--image-get, newsticker--image-sentinel): + * net/tramp-sh.el (tramp-get-remote-touch): + * progmodes/opascal.el (opascal-debug-log): + * textmodes/remember.el (remember-mail-date) + (remember-store-in-files): + * vc/vc-annotate.el (vc-annotate-display-autoscale) + (vc-default-annotate-current-time): + * vc/vc-bzr.el (vc-bzr-shelve-snapshot): + * vc/vc-cvs.el (vc-cvs-annotate-current-time): + * vc/vc-rcs.el (vc-rcs-annotate-current-time): + Omit unnecessary call to current-time. + * calendar/time-date.el (time-to-seconds) [!float-time]: + * vc/vc-annotate.el (vc-annotate-convert-time): + Use current time if arg is nil, to be compatible with float-time. + (time-date--day-in-year): New function, with most of the guts of + the old time-to-day-in-year. + (time-to-day-in-year): Use it. + (time-to-days): Use it, to avoid decoding the same time stamp twice. + * calendar/timeclock.el (timeclock-time-to-date): + Arg is now optional, like current-time-string. + (timeclock-update-mode-line): + Don't call current-time twice to get the current time stamp, + as this can lead to inconsistent results. + * completion.el (cmpl-hours-since-origin): + * ido.el (ido-time-stamp): + * vc/vc-annotate.el (vc-annotate-convert-time): + Simplify by using float-time. + * completion.el (save-completions-to-file): + Rename local var to avoid confusion. + * net/rcirc.el (rcirc-float-time): Simplify to an alias because + time-to-seconds now behaves like float-time with respect to nil arg. + * subr.el (progress-reporter-do-update): + Don't call float-time unless needed. + 2014-10-29 Leo Liu * net/rcirc.el (rcirc-fill-column): Use function. === modified file 'lisp/allout-widgets.el' --- lisp/allout-widgets.el 2014-05-01 23:55:25 +0000 +++ lisp/allout-widgets.el 2014-10-29 01:42:51 +0000 @@ -902,7 +902,7 @@ (header (format "allout-widgets-last-hook-error stored, %s/%s %s %s" this mode args - (format-time-string "%e-%b-%Y %r" (current-time))))) + (format-time-string "%e-%b-%Y %r")))) ;; post to *Messages* then immediately replace with more compact notice: (message "%s" (setq allout-widgets-last-hook-error (format "%s:\n%s" header bt))) === modified file 'lisp/calendar/appt.el' --- lisp/calendar/appt.el 2014-01-01 07:43:34 +0000 +++ lisp/calendar/appt.el 2014-10-29 01:42:51 +0000 @@ -228,7 +228,7 @@ string (car string))) (cond ((eq appt-display-format 'window) ;; TODO use calendar-month-abbrev-array rather than %b? - (let ((time (format-time-string "%a %b %e " (current-time))) + (let ((time (format-time-string "%a %b %e ")) err) (condition-case err (funcall appt-disp-window-function === modified file 'lisp/calendar/icalendar.el' --- lisp/calendar/icalendar.el 2014-10-06 02:02:04 +0000 +++ lisp/calendar/icalendar.el 2014-10-29 01:42:51 +0000 @@ -1682,7 +1682,7 @@ (cons (concat ;;Start today (yes this is an arbitrary choice): "\nDTSTART;VALUE=DATE:" - (format-time-string "%Y%m%d" (current-time)) + (format-time-string "%Y%m%d") ;;BUT remove today if `diary-float' ;;expression does not hold true for today: (when @@ -1691,7 +1691,7 @@ (diary-float month dayname n))) (concat "\nEXDATE;VALUE=DATE:" - (format-time-string "%Y%m%d" (current-time)))) + (format-time-string "%Y%m%d"))) "\nRRULE:" (if (or (numberp month) (listp month)) "FREQ=YEARLY;BYMONTH=" === modified file 'lisp/calendar/time-date.el' --- lisp/calendar/time-date.el 2014-08-03 15:38:52 +0000 +++ lisp/calendar/time-date.el 2014-10-29 01:42:51 +0000 @@ -44,7 +44,7 @@ Each element of the list VARLIST is a list of the form \(HIGH-SYMBOL LOW-SYMBOL MICRO-SYMBOL [PICO-SYMBOL [TYPE-SYMBOL]] TIME-VALUE). -The time value TIME-VALUE is decoded and the result it bound to +The time value TIME-VALUE is decoded and the result is bound to the symbols HIGH-SYMBOL, LOW-SYMBOL and MICRO-SYMBOL. The optional PICO-SYMBOL is bound to the picoseconds part. @@ -147,10 +147,12 @@ (or (featurep 'emacs) (and (fboundp 'float-time) (subrp (symbol-function 'float-time))) - (defun time-to-seconds (time) - "Convert time value TIME to a floating point number." - (with-decoded-time-value ((high low micro pico type time)) - (+ (* 1.0 high 65536) + (defun time-to-seconds (&optional time) + "Convert optional value TIME to a floating point number. +TIME defaults to the current time." + (with-decoded-time-value ((high low micro pico type + (or time (current-time)))) + (+ (* high 65536.0) low (/ (+ (* micro 1e6) pico) 1e12)))))) @@ -272,11 +274,9 @@ (not (zerop (% year 100)))) (zerop (% year 400)))) -;;;###autoload -(defun time-to-day-in-year (time) - "Return the day number within the year corresponding to TIME." - (let* ((tim (decode-time time)) - (month (nth 4 tim)) +(defun time-date--day-in-year (tim) + "Return the day number within the year corresponding to the decoded time TIM." + (let* ((month (nth 4 tim)) (day (nth 3 tim)) (year (nth 5 tim)) (day-of-year (+ day (* 31 (1- month))))) @@ -287,13 +287,18 @@ day-of-year)) ;;;###autoload +(defun time-to-day-in-year (time) + "Return the day number within the year corresponding to TIME." + (time-date--day-in-year (decode-time time))) + +;;;###autoload (defun time-to-days (time) "The number of days between the Gregorian date 0001-12-31bce and TIME. TIME should be a time value. The Gregorian date Sunday, December 31, 1bce is imaginary." (let* ((tim (decode-time time)) (year (nth 5 tim))) - (+ (time-to-day-in-year time) ; Days this year + (+ (time-date--day-in-year tim) ; Days this year (* 365 (1- year)) ; + Days in prior years (/ (1- year) 4) ; + Julian leap years (- (/ (1- year) 100)) ; - century years === modified file 'lisp/calendar/timeclock.el' --- lisp/calendar/timeclock.el 2014-01-27 02:02:28 +0000 +++ lisp/calendar/timeclock.el 2014-10-29 01:42:51 +0000 @@ -320,7 +320,7 @@ (cancel-timer timeclock-update-timer) (setq timeclock-update-timer nil)))) -(defsubst timeclock-time-to-date (time) +(defsubst timeclock-time-to-date (&optional time) "Convert the TIME value to a textual date string." (format-time-string "%Y/%m/%d" time)) @@ -351,7 +351,7 @@ (unless (and timeclock-last-event (equal (timeclock-time-to-date (cadr timeclock-last-event)) - (timeclock-time-to-date (current-time)))) + (timeclock-time-to-date))) (let ((workday (or (and (numberp arg) arg) (and arg 0) (and timeclock-get-workday-function @@ -543,7 +543,7 @@ If TODAY-ONLY is non-nil, the value returned will be relative only to the time worked today, and not to past time." (timeclock-seconds-to-time - (- (timeclock-time-to-seconds (current-time)) + (- (timeclock-time-to-seconds) (let ((discrep (timeclock-find-discrep))) (if discrep (if today-only @@ -647,14 +647,12 @@ (if timeclock-use-elapsed (timeclock-workday-elapsed) (timeclock-workday-remaining (not timeclock-relative)))) - (last-in (equal (car timeclock-last-event) "i"))) + (last-in (equal (car timeclock-last-event) "i")) + (todays-date (timeclock-time-to-date))) (when (and (< remainder 0) (not (and timeclock-day-over - (equal timeclock-day-over - (timeclock-time-to-date - (current-time)))))) - (setq timeclock-day-over - (timeclock-time-to-date (current-time))) + (equal timeclock-day-over todays-date)))) + (setq timeclock-day-over todays-date) (run-hooks 'timeclock-day-over-hook)) (setq timeclock-mode-string (propertize @@ -725,9 +723,8 @@ This is only provided for coherency when used by `timeclock-discrepancy'." (if (equal (car timeclock-last-event) "i") - (- (timeclock-time-to-seconds (or moment (current-time))) - (timeclock-time-to-seconds - (cadr timeclock-last-event))) + (- (timeclock-time-to-seconds moment) + (timeclock-time-to-seconds (cadr timeclock-last-event))) timeclock-last-period)) (defsubst timeclock-entry-length (entry) @@ -1156,7 +1153,7 @@ (+ timeclock-last-period timeclock-elapsed))))) (setq timeclock-last-event event timeclock-last-event-workday - (if (equal (timeclock-time-to-date now) last-date-limited) + (if (equal todays-date last-date-limited) last-date-seconds timeclock-workday)) (forward-line)) @@ -1182,7 +1179,7 @@ (defun timeclock-day-base (&optional time) "Given a time within a day, return 0:0:0 within that day. If optional argument TIME is non-nil, use that instead of the current time." - (let ((decoded (decode-time (or time (current-time))))) + (let ((decoded (decode-time time))) (setcar (nthcdr 0 decoded) 0) (setcar (nthcdr 1 decoded) 0) (setcar (nthcdr 2 decoded) 0) === modified file 'lisp/cedet/ChangeLog' --- lisp/cedet/ChangeLog 2014-10-24 04:09:55 +0000 +++ lisp/cedet/ChangeLog 2014-10-29 01:42:51 +0000 @@ -1,3 +1,10 @@ +2014-10-29 Paul Eggert + + Simplify use of current-time and friends. + * srecode/args.el (srecode-semantic-handle-:time): + Don't call current-time twice to get the current time stamp, + as this can lead to inconsistent results. + 2014-10-24 Stefan Monnier * semantic/complete.el: Require semantic/db-find. === modified file 'lisp/cedet/srecode/args.el' --- lisp/cedet/srecode/args.el 2014-01-01 07:43:34 +0000 +++ lisp/cedet/srecode/args.el 2014-10-29 01:42:51 +0000 @@ -101,35 +101,35 @@ (defun srecode-semantic-handle-:time (dict) "Add macros into the dictionary DICT based on the current :time." ;; DATE Values - (srecode-dictionary-set-value - dict "YEAR" (format-time-string "%Y" (current-time))) - (srecode-dictionary-set-value - dict "MONTHNAME" (format-time-string "%B" (current-time))) - (srecode-dictionary-set-value - dict "MONTH" (format-time-string "%m" (current-time))) - (srecode-dictionary-set-value - dict "DAY" (format-time-string "%d" (current-time))) - (srecode-dictionary-set-value - dict "WEEKDAY" (format-time-string "%a" (current-time))) - ;; Time Values - (srecode-dictionary-set-value - dict "HOUR" (format-time-string "%H" (current-time))) - (srecode-dictionary-set-value - dict "HOUR12" (format-time-string "%l" (current-time))) - (srecode-dictionary-set-value - dict "AMPM" (format-time-string "%p" (current-time))) - (srecode-dictionary-set-value - dict "MINUTE" (format-time-string "%M" (current-time))) - (srecode-dictionary-set-value - dict "SECOND" (format-time-string "%S" (current-time))) - (srecode-dictionary-set-value - dict "TIMEZONE" (format-time-string "%Z" (current-time))) - ;; Convenience pre-packed date/time - (srecode-dictionary-set-value - dict "DATE" (format-time-string "%D" (current-time))) - (srecode-dictionary-set-value - dict "TIME" (format-time-string "%X" (current-time))) - ) + (let ((now (current-time))) + (srecode-dictionary-set-value + dict "YEAR" (format-time-string "%Y" now)) + (srecode-dictionary-set-value + dict "MONTHNAME" (format-time-string "%B" now)) + (srecode-dictionary-set-value + dict "MONTH" (format-time-string "%m" now)) + (srecode-dictionary-set-value + dict "DAY" (format-time-string "%d" now)) + (srecode-dictionary-set-value + dict "WEEKDAY" (format-time-string "%a" now)) + ;; Time Values + (srecode-dictionary-set-value + dict "HOUR" (format-time-string "%H" now)) + (srecode-dictionary-set-value + dict "HOUR12" (format-time-string "%l" now)) + (srecode-dictionary-set-value + dict "AMPM" (format-time-string "%p" now)) + (srecode-dictionary-set-value + dict "MINUTE" (format-time-string "%M" now)) + (srecode-dictionary-set-value + dict "SECOND" (format-time-string "%S" now)) + (srecode-dictionary-set-value + dict "TIMEZONE" (format-time-string "%Z" now)) + ;; Convenience pre-packed date/time + (srecode-dictionary-set-value + dict "DATE" (format-time-string "%D" now)) + (srecode-dictionary-set-value + dict "TIME" (format-time-string "%X" now)))) ;;; :file ARGUMENT HANDLING ;; === modified file 'lisp/completion.el' --- lisp/completion.el 2014-02-10 01:34:22 +0000 +++ lisp/completion.el 2014-10-29 01:42:51 +0000 @@ -435,8 +435,7 @@ (defun cmpl-hours-since-origin () - (let ((time (current-time))) - (floor (+ (* 65536.0 (nth 0 time)) (nth 1 time)) 3600))) + (floor (float-time) 3600)) ;;--------------------------------------------------------------------------- ;; "Symbol" parsing functions @@ -1950,7 +1949,7 @@ (kept-old-versions 0) (kept-new-versions completions-file-versions-kept) last-use-time - (current-time (cmpl-hours-since-origin)) + (this-use-time (cmpl-hours-since-origin)) (total-in-db 0) (total-perm 0) (total-saved 0) @@ -1982,13 +1981,13 @@ ;; or if (if (> (completion-num-uses completion) 0) ;; it's been used - (setq last-use-time current-time) + (setq last-use-time this-use-time) ;; or it was saved before and (and last-use-time ;; save-completions-retention-time is nil (or (not save-completions-retention-time) ;; or time since last use is < ...retention-time* - (< (- current-time last-use-time) + (< (- this-use-time last-use-time) save-completions-retention-time))))) ;; write to file (setq total-saved (1+ total-saved)) === modified file 'lisp/erc/ChangeLog' --- lisp/erc/ChangeLog 2014-10-20 19:59:41 +0000 +++ lisp/erc/ChangeLog 2014-10-29 01:42:51 +0000 @@ -1,3 +1,10 @@ +2014-10-29 Paul Eggert + + Simplify use of current-time and friends. + * erc-backend.el (TOPIC): Omit unnecessary call to current-time. + * erc.el (erc-emacs-time-to-erc-time): Simplify by using float-time. + (erc-current-time): Simplify by using erc-emacs-time-to-erc-time. + 2014-10-20 Glenn Morris * Merge in all changes up to 24.4 release. === modified file 'lisp/erc/erc-backend.el' --- lisp/erc/erc-backend.el 2014-06-19 16:56:18 +0000 +++ lisp/erc/erc-backend.el 2014-10-29 01:42:51 +0000 @@ -1465,8 +1465,7 @@ "The channel topic has changed." nil (let* ((ch (car (erc-response.command-args parsed))) (topic (erc-trim-string (erc-response.contents parsed))) - (time (format-time-string erc-server-timestamp-format - (current-time)))) + (time (format-time-string erc-server-timestamp-format))) (pcase-let ((`(,nick ,login ,host) (erc-parse-user (erc-response.sender parsed)))) (erc-update-channel-member ch nick nick nil nil nil nil nil nil host login) === modified file 'lisp/erc/erc.el' --- lisp/erc/erc.el 2014-10-10 16:53:19 +0000 +++ lisp/erc/erc.el 2014-10-29 01:42:51 +0000 @@ -5956,17 +5956,15 @@ (list (truncate (/ n 65536)) (truncate (mod n 65536))))) -(defun erc-emacs-time-to-erc-time (time) - "Convert Emacs TIME to a number of seconds since the epoch." - (when time - (+ (* (nth 0 time) 65536.0) (nth 1 time)))) -; (round (+ (* (nth 0 tm) 65536.0) (nth 1 tm)))) +(defalias 'erc-emacs-time-to-erc-time + (if (featurep 'xemacs) 'time-to-seconds 'float-time) + "Convert time value TIME to a floating point number. +TIME defaults to the current time.") -(defun erc-current-time () +(defalias 'erc-current-time 'erc-emacs-time-to-erc-time "Return the `current-time' as a number of seconds since the epoch. -See also `erc-emacs-time-to-erc-time'." - (erc-emacs-time-to-erc-time (current-time))) +See also `erc-emacs-time-to-erc-time'.") (defun erc-time-diff (t1 t2) "Return the time difference in seconds between T1 and T2." === modified file 'lisp/eshell/em-ls.el' --- lisp/eshell/em-ls.el 2014-01-01 07:43:34 +0000 +++ lisp/eshell/em-ls.el 2014-10-29 01:42:51 +0000 @@ -490,7 +490,7 @@ " " (format-time-string (concat eshell-ls-date-format " " - (if (= (nth 5 (decode-time (current-time))) + (if (= (nth 5 (decode-time)) (nth 5 (decode-time (nth (cond ((eq sort-method 'by-atime) 4) === modified file 'lisp/eshell/esh-util.el' --- lisp/eshell/esh-util.el 2014-09-29 18:14:08 +0000 +++ lisp/eshell/esh-util.el 2014-10-29 01:42:51 +0000 @@ -653,7 +653,7 @@ (match-string 6)))) (if (nth 0 moment) (setcar (nthcdr 5 moment) - (nth 5 (decode-time (current-time)))) + (nth 5 (decode-time))) (setcar (nthcdr 0 moment) 0) (setcar (nthcdr 1 moment) 0) (setcar (nthcdr 2 moment) 0)) === modified file 'lisp/generic-x.el' --- lisp/generic-x.el 2014-01-01 07:43:34 +0000 +++ lisp/generic-x.el 2014-10-29 01:42:51 +0000 @@ -1650,7 +1650,7 @@ (defun named-database-print-serial () "Print a serial number based on the current date." (interactive) - (insert (format-time-string named-database-time-string (current-time))))) + (insert (format-time-string named-database-time-string)))) (when (memq 'resolve-conf-generic-mode generic-extras-enable-list) === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2014-10-27 03:51:18 +0000 +++ lisp/gnus/ChangeLog 2014-10-29 01:42:51 +0000 @@ -1,3 +1,16 @@ +2014-10-29 Paul Eggert + + Simplify use of current-time and friends. + * gnus-delay.el (gnus-delay-article): + * gnus-sum.el (gnus-summary-read-document): + * gnus-util.el (gnus-seconds-today, gnus-seconds-month): + * message.el (message-make-expires-date): + Omit unnecessary call to current-time. + * gnus-util.el (gnus-float-time): Simplify to an alias because + time-to-seconds now behaves like float-time with respect to nil arg. + (gnus-seconds-year): Don't call current-time twice to get the current + time stamp, as this can lead to inconsistent results. + 2014-10-27 Katsumi Yamaoka * gnus.el (gnus-mode-line-buffer-identification): === modified file 'lisp/gnus/gnus-delay.el' --- lisp/gnus/gnus-delay.el 2014-10-04 23:55:04 +0000 +++ lisp/gnus/gnus-delay.el 2014-10-29 01:42:51 +0000 @@ -98,7 +98,7 @@ (setq hour (string-to-number (match-string 1 delay)) minute (string-to-number (match-string 2 delay))) ;; Use current time, except... - (setq deadline (apply 'vector (decode-time (current-time)))) + (setq deadline (apply 'vector (decode-time))) ;; ... for minute and hour. (aset deadline 1 minute) (aset deadline 2 hour) === modified file 'lisp/gnus/gnus-sum.el' --- lisp/gnus/gnus-sum.el 2014-08-14 11:31:23 +0000 +++ lisp/gnus/gnus-sum.el 2014-10-29 01:42:51 +0000 @@ -9333,7 +9333,7 @@ ((gnus-group-read-ephemeral-group (setq vgroup (format "nnvirtual:%s-%s" gnus-newsgroup-name - (format-time-string "%Y%m%dT%H%M%S" (current-time)))) + (format-time-string "%Y%m%dT%H%M%S"))) `(nnvirtual ,vgroup (nnvirtual-component-groups ,groups)) t (cons (current-buffer) 'summary))) === modified file 'lisp/gnus/gnus-util.el' --- lisp/gnus/gnus-util.el 2014-07-22 06:37:31 +0000 +++ lisp/gnus/gnus-util.el 2014-10-29 01:42:51 +0000 @@ -313,14 +313,12 @@ ;; Every version of Emacs Gnus supports has built-in float-time. ;; The featurep test silences an irritating compiler warning. -(eval-and-compile +(defalias 'gnus-float-time (if (or (featurep 'emacs) (fboundp 'float-time)) - (defalias 'gnus-float-time 'float-time) - (defun gnus-float-time (&optional time) - "Convert time value TIME to a floating point number. -TIME defaults to the current time." - (time-to-seconds (or time (current-time)))))) + 'float-time 'time-to-seconds) + "Convert time value TIME to a floating point number. +TIME defaults to the current time.") ;;; Keymap macros. @@ -389,19 +387,20 @@ (defun gnus-seconds-today () "Return the number of seconds passed today." - (let ((now (decode-time (current-time)))) + (let ((now (decode-time))) (+ (car now) (* (car (cdr now)) 60) (* (car (nthcdr 2 now)) 3600)))) (defun gnus-seconds-month () "Return the number of seconds passed this month." - (let ((now (decode-time (current-time)))) + (let ((now (decode-time))) (+ (car now) (* (car (cdr now)) 60) (* (car (nthcdr 2 now)) 3600) (* (- (car (nthcdr 3 now)) 1) 3600 24)))) (defun gnus-seconds-year () "Return the number of seconds passed this year." - (let ((now (decode-time (current-time))) - (days (format-time-string "%j" (current-time)))) + (let* ((current (current-time)) + (now (decode-time current)) + (days (format-time-string "%j" current))) (+ (car now) (* (car (cdr now)) 60) (* (car (nthcdr 2 now)) 3600) (* (- (string-to-number days) 1) 3600 24)))) === modified file 'lisp/gnus/message.el' --- lisp/gnus/message.el 2014-10-16 22:12:47 +0000 +++ lisp/gnus/message.el 2014-10-29 01:42:51 +0000 @@ -5550,7 +5550,7 @@ "Make date string for the Expires header. Expiry in DAYS days. In posting styles use `(\"Expires\" (make-expires-date 30))'." - (let* ((cur (decode-time (current-time))) + (let* ((cur (decode-time)) (nday (+ days (nth 3 cur)))) (setf (nth 3 cur) nday) (message-make-date (apply 'encode-time cur)))) === modified file 'lisp/ido.el' --- lisp/ido.el 2014-03-03 02:27:08 +0000 +++ lisp/ido.el 2014-10-29 01:42:51 +0000 @@ -1306,8 +1306,7 @@ (defun ido-time-stamp (&optional time) ;; Time is a floating point number (fractions of 1 hour) - (setq time (or time (current-time))) - (/ (+ (* (car time) 65536.0) (car (cdr time))) 3600.0)) + (/ (float-time time) 3600)) (defun ido-cache-ftp-valid (&optional time) (and (numberp ido-cache-ftp-work-directory-time) === modified file 'lisp/net/newst-backend.el' --- lisp/net/newst-backend.el 2014-10-20 19:47:51 +0000 +++ lisp/net/newst-backend.el 2014-10-29 01:42:51 +0000 @@ -757,7 +757,7 @@ ) ((eq status-type :error) (message "%s: Error while retrieving news from %s: %s: \"%s\"" - (format-time-string "%A, %H:%M" (current-time)) + (format-time-string "%A, %H:%M") feed-name (car status-details) (cdr status-details)))))))) @@ -787,7 +787,7 @@ FEED-NAME must be a string which occurs as the label (i.e. the first element) in an element of `newsticker-url-list' or `newsticker-url-list-defaults'." (newsticker--debug-msg "%s: Getting news for %s" - (format-time-string "%A, %H:%M" (current-time)) + (format-time-string "%A, %H:%M") feed-name) (let* ((item (or (assoc feed-name newsticker-url-list) (assoc feed-name newsticker-url-list-defaults) @@ -845,14 +845,14 @@ (concat "%s: Newsticker could not retrieve news from %s.\n" "Return status: `%s'\n" "Command was `%s'") - (format-time-string "%A, %H:%M" (current-time)) + (format-time-string "%A, %H:%M") feed-name event command) "" (current-time) 'new 0 nil)) (message "%s: Error while retrieving news from %s" - (format-time-string "%A, %H:%M" (current-time)) + (format-time-string "%A, %H:%M") feed-name) (throw 'oops nil)) (let* ((coding-system 'utf-8) @@ -1020,7 +1020,7 @@ (defun newsticker--do-xml-workarounds () "Fix all issues which `xml-parse-region' could be choking on." - + ;; a very very dirty workaround to overcome the ;; problems with the newest (20030621) xml.el: ;; remove all unnecessary whitespace @@ -1808,11 +1808,11 @@ (time-add (nth 5 (file-attributes image-name)) (seconds-to-time 86400)))) (newsticker--debug-msg "%s: Getting image for %s skipped" - (format-time-string "%A, %H:%M" (current-time)) + (format-time-string "%A, %H:%M") feed-name) ;; download (newsticker--debug-msg "%s: Getting image for %s" - (format-time-string "%A, %H:%M" (current-time)) + (format-time-string "%A, %H:%M") feed-name) (if (eq newsticker-retrieval-method 'intern) (newsticker--image-download-by-url feed-name filename directory url) @@ -1859,7 +1859,7 @@ (unless (and (eq p-status 'exit) (= exit-status 0)) (message "%s: Error while retrieving image from %s" - (format-time-string "%A, %H:%M" (current-time)) + (format-time-string "%A, %H:%M") feed-name) (newsticker--image-remove directory feed-name) (throw 'oops nil)) === modified file 'lisp/net/rcirc.el' --- lisp/net/rcirc.el 2014-10-29 01:37:16 +0000 +++ lisp/net/rcirc.el 2014-10-29 01:42:51 +0000 @@ -599,10 +599,10 @@ `(with-current-buffer rcirc-server-buffer ,@body)) -(defun rcirc-float-time () +(defalias 'rcirc-float-time (if (featurep 'xemacs) - (time-to-seconds (current-time)) - (float-time))) + 'time-to-seconds + 'float-time)) (defun rcirc-prompt-for-encryption (server-plist) "Prompt the user for the encryption method to use. === modified file 'lisp/net/tramp-sh.el' --- lisp/net/tramp-sh.el 2014-10-14 11:59:16 +0000 +++ lisp/net/tramp-sh.el 2014-10-29 01:42:51 +0000 @@ -5213,7 +5213,7 @@ (format "%s -t %s %s" result - (format-time-string "%Y%m%d%H%M.%S" (current-time)) + (format-time-string "%Y%m%d%H%M.%S") (tramp-file-name-handler 'file-remote-p tmpfile 'localname)))) (delete-file tmpfile)) result))) === modified file 'lisp/org/ChangeLog' --- lisp/org/ChangeLog 2014-10-23 01:38:59 +0000 +++ lisp/org/ChangeLog 2014-10-29 01:42:51 +0000 @@ -1,3 +1,24 @@ +2014-10-29 Paul Eggert + + Simplify use of current-time and friends. + * org-archive.el (org-archive-subtree) + (org-archive-to-archive-sibling): + * org-clock.el (org-resolve-clocks, org-clock-get-sum-start) + (org-clock-special-range): + * org-timer.el (org-timer-seconds): + * org.el (org-read-date-analyze, org-get-cursor-date): + * ox-html.el (org-html-format-spec): + * ox-icalendar.el (org-icalendar--vtodo): + Omit unnecessary call to current-time. + * org-clock.el (org-clock-get-table-data): Omit unnecessary, lossy + conversion from floating point to Emacs time and back. + (org-resolve-clocks): Prefer two-argument floor. + * org-compat.el (org-float-time): Simplify to an alias because + time-to-seconds now behaves like float-time with respect to nil arg. + * org.el (org-get-cursor-date): + Don't call current-time twice to get the current time stamp, + as this can lead to inconsistent results. + 2014-10-20 Glenn Morris * Merge in all changes up to 24.4 release. === modified file 'lisp/org/org-archive.el' --- lisp/org/org-archive.el 2014-01-01 07:43:34 +0000 +++ lisp/org/org-archive.el 2014-10-29 01:42:51 +0000 @@ -231,8 +231,7 @@ (error "No file associated to buffer")))) (olpath (mapconcat 'identity (org-get-outline-path) "/")) (time (format-time-string - (substring (cdr org-time-stamp-formats) 1 -1) - (current-time))) + (substring (cdr org-time-stamp-formats) 1 -1))) category todo priority ltags itags atags ;; end of variables that will be used for saving context location afile heading buffer level newfile-p infile-p visiting @@ -441,8 +440,7 @@ (org-set-property "ARCHIVE_TIME" (format-time-string - (substring (cdr org-time-stamp-formats) 1 -1) - (current-time))) + (substring (cdr org-time-stamp-formats) 1 -1))) (outline-up-heading 1 t) (hide-subtree) (org-cycle-show-empty-lines 'folded) === modified file 'lisp/org/org-clock.el' --- lisp/org/org-clock.el 2014-10-03 15:44:46 +0000 +++ lisp/org/org-clock.el 2014-10-29 01:42:51 +0000 @@ -1046,9 +1046,9 @@ (lambda (clock) (format "Dangling clock started %d mins ago" - (floor - (/ (- (org-float-time (current-time)) - (org-float-time (cdr clock))) 60)))))) + (floor (- (org-float-time) + (org-float-time (cdr clock))) + 60))))) (or last-valid (cdr clock))))))))))) @@ -1368,7 +1368,7 @@ (current-time)) ((equal cmt "today") (setq org--msg-extra "showing today's task time.") - (let* ((dt (decode-time (current-time)))) + (let* ((dt (decode-time))) (setq dt (append (list 0 0 0) (nthcdr 3 dt))) (if org-extend-today-until (setf (nth 2 dt) org-extend-today-until)) @@ -2029,7 +2029,7 @@ month (1 is the first day of the month). If you can combine both, the month starting day will have priority." (if (integerp key) (setq key (intern (number-to-string key)))) - (let* ((tm (decode-time (or time (current-time)))) + (let* ((tm (decode-time time)) (s 0) (m (nth 1 tm)) (h (nth 2 tm)) (d (nth 3 tm)) (month (nth 4 tm)) (y (nth 5 tm)) (dow (nth 6 tm)) @@ -2670,10 +2670,8 @@ (when (and te (listp te)) (setq te (format "%4d-%02d-%02d" (nth 2 te) (car te) (nth 1 te)))) ;; Now the times are strings we can parse. - (if ts (setq ts (org-float-time - (seconds-to-time (org-matcher-time ts))))) - (if te (setq te (org-float-time - (seconds-to-time (org-matcher-time te))))) + (if ts (setq ts (org-matcher-time ts))) + (if te (setq te (org-matcher-time te))) (save-excursion (org-clock-sum ts te (unless (null matcher) === modified file 'lisp/org/org-compat.el' --- lisp/org/org-compat.el 2014-10-03 15:44:46 +0000 +++ lisp/org/org-compat.el 2014-10-29 01:42:51 +0000 @@ -411,12 +411,10 @@ (when focus-follows-mouse (set-mouse-position frame (1- (frame-width frame)) 0))))) -(defun org-float-time (&optional time) +(defalias 'org-float-time + (if (featurep 'xemacs) 'time-to-seconds 'float-time) "Convert time value TIME to a floating point number. -TIME defaults to the current time." - (if (featurep 'xemacs) - (time-to-seconds (or time (current-time))) - (float-time time))) +TIME defaults to the current time.") ;; `user-error' is only available from 24.2.50 on (unless (fboundp 'user-error) === modified file 'lisp/org/org-timer.el' --- lisp/org/org-timer.el 2014-10-03 08:13:51 +0000 +++ lisp/org/org-timer.el 2014-10-29 01:42:51 +0000 @@ -195,8 +195,8 @@ (defun org-timer-seconds () (if org-timer-timer-is-countdown (- (org-float-time org-timer-start-time) - (org-float-time (current-time))) - (- (org-float-time (or org-timer-pause-time (current-time))) + (org-float-time)) + (- (org-float-time org-timer-pause-time) (org-float-time org-timer-start-time)))) ;;;###autoload === modified file 'lisp/org/org.el' --- lisp/org/org.el 2014-10-12 22:56:45 +0000 +++ lisp/org/org.el 2014-10-29 01:42:51 +0000 @@ -16490,7 +16490,7 @@ (defun org-read-date-analyze (ans org-def org-defdecode) "Analyze the combined answer of the date prompt." ;; FIXME: cleanup and comment - (let ((nowdecode (decode-time (current-time))) + (let ((nowdecode (decode-time)) delta deltan deltaw deltadef year month day hour minute second wday pm h2 m2 tl wday1 iso-year iso-weekday iso-week iso-year iso-date futurep kill-year) @@ -16648,7 +16648,7 @@ (deltan (setq futurep nil) (unless deltadef - (let ((now (decode-time (current-time)))) + (let ((now (decode-time))) (setq day (nth 3 now) month (nth 4 now) year (nth 5 now)))) (cond ((member deltaw '("d" "")) (setq day (+ day deltan))) ((equal deltaw "w") (setq day (+ day (* 7 deltan)))) @@ -22062,8 +22062,9 @@ (when (and tp (string-match "\\([0-9][0-9]\\):\\([0-9][0-9]\\)" tp)) (setq hod (string-to-number (match-string 1 tp)) mod (string-to-number (match-string 2 tp)))) - (or tp (setq hod (nth 2 (decode-time (current-time))) - mod (nth 1 (decode-time (current-time)))))) + (or tp (let ((now (decode-time))) + (setq hod (nth 2 now) + mod (nth 1 now))))) (cond ((eq major-mode 'calendar-mode) (setq date (calendar-cursor-to-date) === modified file 'lisp/org/ox-html.el' --- lisp/org/ox-html.el 2014-10-03 15:44:46 +0000 +++ lisp/org/ox-html.el 2014-10-29 01:42:51 +0000 @@ -1630,8 +1630,7 @@ (?c . ,(plist-get info :creator)) (?C . ,(let ((file (plist-get info :input-file))) (format-time-string org-html-metadata-timestamp-format - (if file (nth 5 (file-attributes file)) - (current-time))))) + (if file (nth 5 (file-attributes file)))))) (?v . ,(or org-html-validation-link "")))) (defun org-html--build-pre/postamble (type info) === modified file 'lisp/org/ox-icalendar.el' --- lisp/org/ox-icalendar.el 2014-10-03 08:13:51 +0000 +++ lisp/org/ox-icalendar.el 2014-10-29 01:42:51 +0000 @@ -678,7 +678,7 @@ (org-element-property :scheduled entry)) ;; If we can't use a scheduled time for some ;; reason, start task now. - (let ((now (decode-time (current-time)))) + (let ((now (decode-time))) (list 'timestamp (list :type 'active :minute-start (nth 1 now) === modified file 'lisp/progmodes/opascal.el' --- lisp/progmodes/opascal.el 2014-03-14 00:22:33 +0000 +++ lisp/progmodes/opascal.el 2014-10-29 01:42:51 +0000 @@ -1397,7 +1397,7 @@ (when opascal-debug (opascal-ensure-buffer opascal-debug-buffer "*OPascal Debug Log*") (opascal-log-msg opascal-debug-buffer - (concat (format-time-string "%H:%M:%S " (current-time)) + (concat (format-time-string "%H:%M:%S ") (apply #'format (cons format-string args)) "\n")))) === modified file 'lisp/subr.el' --- lisp/subr.el 2014-10-21 20:11:22 +0000 +++ lisp/subr.el 2014-10-29 01:42:51 +0000 @@ -4507,11 +4507,10 @@ (min-value (aref parameters 1)) (max-value (aref parameters 2)) (text (aref parameters 3)) - (current-time (float-time)) (enough-time-passed ;; See if enough time has passed since the last update. (or (not update-time) - (when (>= current-time update-time) + (when (>= (float-time) update-time) ;; Calculate time for the next update (aset parameters 0 (+ update-time (aref parameters 5))))))) (cond ((and min-value max-value) === modified file 'lisp/textmodes/remember.el' --- lisp/textmodes/remember.el 2014-10-06 02:02:04 +0000 +++ lisp/textmodes/remember.el 2014-10-29 01:42:51 +0000 @@ -319,9 +319,7 @@ (defsubst remember-mail-date (&optional rfc822-p) "Return a simple date. Nothing fancy." - (if rfc822-p - (format-time-string "%a, %e %b %Y %T %z" (current-time)) - (format-time-string "%a %b %e %T %Y" (current-time)))) + (format-time-string (if rfc822-p "%a, %e %b %Y %T %z" "%a %b %e %T %Y"))) (defun remember-buffer-desc () "Using the first line of the current buffer, create a short description." @@ -461,8 +459,7 @@ "Store remember data in a file in `remember-data-directory'. The file is named by calling `format-time-string' using `remember-directory-file-name-format' as the format string." - (let ((name (format-time-string - remember-directory-file-name-format (current-time))) + (let ((name (format-time-string remember-directory-file-name-format)) (text (buffer-string))) (with-temp-buffer (insert text) === modified file 'lisp/url/ChangeLog' --- lisp/url/ChangeLog 2014-10-21 01:17:06 +0000 +++ lisp/url/ChangeLog 2014-10-29 01:42:51 +0000 @@ -1,3 +1,11 @@ +2014-10-29 Paul Eggert + + Simplify use of current-time and friends. + * url-cache.el (url-cache-prune-cache): + Rename local var to avoid confusion. + * url-util.el (url-get-normalized-date): + Omit unnecessary call to current-time. + 2014-10-20 Glenn Morris * Merge in all changes up to 24.4 release. === modified file 'lisp/url/url-cache.el' --- lisp/url/url-cache.el 2014-01-01 07:43:34 +0000 +++ lisp/url/url-cache.el 2014-10-29 01:42:51 +0000 @@ -212,7 +212,7 @@ "Remove all expired files from the cache. `url-cache-expire-time' says how old a file has to be to be considered \"expired\"." - (let ((current-time (current-time)) + (let ((now (current-time)) (total-files 0) (deleted-files 0)) (setq directory (or directory url-cache-directory)) @@ -228,7 +228,7 @@ (time-add (nth 5 (file-attributes file)) (seconds-to-time url-cache-expire-time)) - current-time) + now) (delete-file file) (setq deleted-files (1+ deleted-files)))))) (if (< deleted-files total-files) === modified file 'lisp/url/url-util.el' --- lisp/url/url-util.el 2014-05-14 17:15:15 +0000 +++ lisp/url/url-util.el 2014-10-29 01:42:51 +0000 @@ -189,8 +189,7 @@ (defun url-get-normalized-date (&optional specified-time) "Return a 'real' date string that most HTTP servers can understand." (let ((system-time-locale "C")) - (format-time-string "%a, %d %b %Y %T GMT" - (or specified-time (current-time)) t))) + (format-time-string "%a, %d %b %Y %T GMT" specified-time t))) ;;;###autoload (defun url-eat-trailing-space (x) === modified file 'lisp/vc/vc-annotate.el' --- lisp/vc/vc-annotate.el 2014-09-29 18:14:08 +0000 +++ lisp/vc/vc-annotate.el 2014-10-29 01:42:51 +0000 @@ -253,7 +253,7 @@ (interactive "P") (let ((newest 0.0) (oldest 999999.) ;Any CVS users at the founding of Rome? - (current (vc-annotate-convert-time (current-time))) + (current (vc-annotate-convert-time)) date) (message "Redisplaying annotation...") ;; Run through this file and find the oldest and newest dates annotated. @@ -664,11 +664,10 @@ (setq i (+ i 1))) tmp-cons)) ; Return the appropriate value -(defun vc-annotate-convert-time (time) - "Convert a time value to a floating-point number of days. -The argument TIME is a list as returned by `current-time' or -`encode-time', only the first two elements of that list are considered." - (/ (+ (* (float (car time)) (lsh 1 16)) (cadr time)) 24 3600)) +(defun vc-annotate-convert-time (&optional time) + "Convert optional value TIME to a floating-point number of days. +TIME defaults to the current time." + (/ (float-time time) 86400)) (defun vc-annotate-difference (&optional offset) "Return the time span in days to the next annotation. @@ -683,7 +682,7 @@ (defun vc-default-annotate-current-time (_backend) "Return the current time, encoded as fractional days." - (vc-annotate-convert-time (current-time))) + (vc-annotate-convert-time)) (defvar vc-annotate-offset nil) === modified file 'lisp/vc/vc-bzr.el' --- lisp/vc/vc-bzr.el 2014-07-21 01:25:59 +0000 +++ lisp/vc/vc-bzr.el 2014-10-29 01:42:51 +0000 @@ -1167,10 +1167,7 @@ "Create a stash with the current tree state." (interactive) (vc-bzr-command "shelve" nil 0 nil "--all" "-m" - (let ((ct (current-time))) - (concat - (format-time-string "Snapshot on %Y-%m-%d" ct) - (format-time-string " at %H:%M" ct)))) + (format-time-string "Snapshot on %Y-%m-%d at %H:%M")) (vc-bzr-command "unshelve" nil 0 nil "--apply" "--keep") (vc-resynch-buffer (vc-bzr-root default-directory) t t)) === modified file 'lisp/vc/vc-cvs.el' --- lisp/vc/vc-cvs.el 2014-01-01 07:43:34 +0000 +++ lisp/vc/vc-cvs.el 2014-10-29 01:42:51 +0000 @@ -605,7 +605,7 @@ "Return the current time, based at midnight of the current day, and encoded as fractional days." (vc-annotate-convert-time - (apply 'encode-time 0 0 0 (nthcdr 3 (decode-time (current-time)))))) + (apply 'encode-time 0 0 0 (nthcdr 3 (decode-time))))) (defun vc-cvs-annotate-time () "Return the time of the next annotation (as fraction of days) === modified file 'lisp/vc/vc-rcs.el' --- lisp/vc/vc-rcs.el 2014-05-20 15:46:21 +0000 +++ lisp/vc/vc-rcs.el 2014-10-29 01:42:51 +0000 @@ -811,7 +811,7 @@ "Return the current time, based at midnight of the current day, and encoded as fractional days." (vc-annotate-convert-time - (apply #'encode-time 0 0 0 (nthcdr 3 (decode-time (current-time)))))) + (apply #'encode-time 0 0 0 (nthcdr 3 (decode-time))))) (defun vc-rcs-annotate-time () "Return the time of the next annotation (as fraction of days) ------------------------------------------------------------ revno: 118227 committer: Leo Liu branch nick: trunk timestamp: Wed 2014-10-29 09:37:16 +0800 message: * net/rcirc.el (rcirc-fill-column): Use function. (rcirc-markup-fill): Remove adjustment. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-10-29 00:37:37 +0000 +++ lisp/ChangeLog 2014-10-29 01:37:16 +0000 @@ -1,3 +1,8 @@ +2014-10-29 Leo Liu + + * net/rcirc.el (rcirc-fill-column): Use function. + (rcirc-markup-fill): Remove adjustment. + 2014-10-28 Christopher Schmidt * calc/calc.el (quick-calc): === modified file 'lisp/net/rcirc.el' --- lisp/net/rcirc.el 2014-10-28 21:55:28 +0000 +++ lisp/net/rcirc.el 2014-10-29 01:37:16 +0000 @@ -146,12 +146,12 @@ (defcustom rcirc-fill-column nil "Column beyond which automatic line-wrapping should happen. If nil, use value of `fill-column'. -If a symbol (e.g., `frame-width' or `window-body-width'), call it -to compute the number of columns." +If a function (e.g., `frame-text-width' or `window-text-width'), +call it to compute the number of columns." :version "25.1" :type '(choice (const :tag "Value of `fill-column'" nil) - (symbol :tag "Function returning the number of columns") - (integer :tag "Number of columns")) + (integer :tag "Number of columns") + (function :tag "Function returning the number of columns")) :group 'rcirc) (defcustom rcirc-fill-prefix nil @@ -2536,8 +2536,8 @@ (or rcirc-fill-prefix (make-string (- (point) (line-beginning-position)) ?\s))) (fill-column (- (cond ((null rcirc-fill-column) fill-column) - ((symbolp rcirc-fill-column) - (1- (funcall rcirc-fill-column))) + ((functionp rcirc-fill-column) + (funcall rcirc-fill-column)) (t rcirc-fill-column)) ;; make sure ... doesn't cause line wrapping 3))) ------------------------------------------------------------ revno: 118226 author: Christopher Schmidt committer: Jay Belanger branch nick: trunk timestamp: Tue 2014-10-28 19:37:37 -0500 message: doc/misc/calc.texi (Quick Calculator): Mention prefix argument of `quick-calc'. etc/NEWS: Mention prefix argument of `quick-calc'. lisp/calc/calc.el (quick-calc): lisp/calc/calc-aent.el (calc-do-quick-calc): New argument INSERT. diff: === modified file 'doc/misc/ChangeLog' --- doc/misc/ChangeLog 2014-10-26 15:38:44 +0000 +++ doc/misc/ChangeLog 2014-10-29 00:37:37 +0000 @@ -1,3 +1,8 @@ +2014-10-28 Christopher Schmidt + + * calc.texi (Quick Calculator): Mention prefix argument of + `quick-calc'. + 2014-10-26 Eric S. Raymond * efaq-w32.texi: Neutralized language specific to a repository type. === modified file 'doc/misc/calc.texi' --- doc/misc/calc.texi 2014-06-10 02:20:31 +0000 +++ doc/misc/calc.texi 2014-10-29 00:37:37 +0000 @@ -10168,9 +10168,10 @@ explicit alternative to @kbd{$} notation, or to yank the result into the Calculator stack after typing @kbd{C-x * c}. -If you finish your formula by typing @key{LFD} (or @kbd{C-j}) instead -of @key{RET}, the result is inserted immediately into the current -buffer rather than going into the kill ring. +If you give a prefix argument to @kbd{C-x * q} or finish your formula +by typing @key{LFD} (or @kbd{C-j}) instead of @key{RET}, the result is +inserted immediately into the current buffer rather than going into +the kill ring. Quick Calculator results are actually evaluated as if by the @kbd{=} key (which replaces variable names by their stored values, if any). === modified file 'etc/ChangeLog' --- etc/ChangeLog 2014-10-21 01:17:06 +0000 +++ etc/ChangeLog 2014-10-29 00:37:37 +0000 @@ -1,3 +1,7 @@ +2014-09-13 Christopher Schmidt + + * NEWS: Mention prefix argument of `quick-calc'. + 2014-10-20 Glenn Morris * Merge in all changes up to 24.4 release. === modified file 'etc/NEWS' --- etc/NEWS 2014-10-22 10:01:17 +0000 +++ etc/NEWS 2014-10-29 00:37:37 +0000 @@ -127,6 +127,11 @@ * Changes in Specialized Modes and Packages in Emacs 25.1 +** Calc ++++ +*** If `quick-calc' is called with a prefix argument, insert the +result of the calculation into the current buffer. + ** ElDoc *** New minor mode global-eldoc-mode *** eldoc-documentation-function now defaults to nil === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-10-28 21:55:28 +0000 +++ lisp/ChangeLog 2014-10-29 00:37:37 +0000 @@ -1,3 +1,8 @@ +2014-10-28 Christopher Schmidt + + * calc/calc.el (quick-calc): + * calc/calc-aent.el (calc-do-quick-calc): New argument INSERT. + 2014-10-28 Sam Steingold * net/rcirc.el (rcirc-fill-column): Allow any symbolic value for === modified file 'lisp/calc/calc-aent.el' --- lisp/calc/calc-aent.el 2014-01-01 07:43:34 +0000 +++ lisp/calc/calc-aent.el 2014-10-29 00:37:37 +0000 @@ -52,7 +52,7 @@ "The history list for quick-calc.") ;;;###autoload -(defun calc-do-quick-calc () +(defun calc-do-quick-calc (&optional insert) (require 'calc-ext) (calc-check-defines) (if (eq major-mode 'calc-mode) @@ -108,7 +108,8 @@ (setq buf long)))) (calc-handle-whys) (message "Result: %s" buf))) - (if (eq last-command-event 10) + (if (or insert + (eq last-command-event 10)) (insert shortbuf) (kill-new shortbuf))))) === modified file 'lisp/calc/calc.el' --- lisp/calc/calc.el 2014-06-28 17:27:29 +0000 +++ lisp/calc/calc.el 2014-10-29 00:37:37 +0000 @@ -147,7 +147,7 @@ (declare-function calc-edit-finish "calc-yank" (&optional keep)) (declare-function calc-edit-cancel "calc-yank" ()) (declare-function calc-locate-cursor-element "calc-yank" (pt)) -(declare-function calc-do-quick-calc "calc-aent" ()) +(declare-function calc-do-quick-calc "calc-aent" (&optional insert)) (declare-function calc-do-calc-eval "calc-aent" (str separator args)) (declare-function calc-do-keypad "calc-keypd" (&optional full-display interactive)) (declare-function calcFunc-unixtime "calc-forms" (date &optional zone)) @@ -1549,10 +1549,12 @@ (and kbuf (bury-buffer kbuf)))))) ;;;###autoload -(defun quick-calc () - "Do a quick calculation in the minibuffer without invoking full Calculator." - (interactive) - (calc-do-quick-calc)) +(defun quick-calc (&optional insert) + "Do a quick calculation in the minibuffer without invoking full Calculator. +With prefix argument INSERT, insert the result in the current +buffer. Otherwise, the result is copied into the kill ring." + (interactive "P") + (calc-do-quick-calc insert)) ;;;###autoload (defun calc-eval (str &optional separator &rest args) ------------------------------------------------------------ revno: 118225 committer: Sam Steingold branch nick: trunk timestamp: Tue 2014-10-28 17:55:28 -0400 message: Allow any symbolic value for `rcirc-fill-column'. * lisp/net/rcirc.el (rcirc-fill-column): Allow any symbolic value for the sake of `window-body-width' (in addition to `frame-width'). diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-10-26 17:57:10 +0000 +++ lisp/ChangeLog 2014-10-28 21:55:28 +0000 @@ -1,3 +1,8 @@ +2014-10-28 Sam Steingold + + * net/rcirc.el (rcirc-fill-column): Allow any symbolic value for + the sake of `window-body-width' (in addition to `frame-width'). + 2014-10-26 Eric S. Raymond * version.el: Fix some fallback values to conform to the actual === modified file 'lisp/net/rcirc.el' --- lisp/net/rcirc.el 2014-09-29 18:14:08 +0000 +++ lisp/net/rcirc.el 2014-10-28 21:55:28 +0000 @@ -145,10 +145,12 @@ (defcustom rcirc-fill-column nil "Column beyond which automatic line-wrapping should happen. -If nil, use value of `fill-column'. If 'frame-width, use the -maximum frame width." - :type '(choice (const :tag "Value of `fill-column'") - (const :tag "Full frame width" frame-width) +If nil, use value of `fill-column'. +If a symbol (e.g., `frame-width' or `window-body-width'), call it +to compute the number of columns." + :version "25.1" + :type '(choice (const :tag "Value of `fill-column'" nil) + (symbol :tag "Function returning the number of columns") (integer :tag "Number of columns")) :group 'rcirc) @@ -2533,11 +2535,10 @@ (let ((fill-prefix (or rcirc-fill-prefix (make-string (- (point) (line-beginning-position)) ?\s))) - (fill-column (- (cond ((eq rcirc-fill-column 'frame-width) - (1- (frame-width))) - (rcirc-fill-column - rcirc-fill-column) - (t fill-column)) + (fill-column (- (cond ((null rcirc-fill-column) fill-column) + ((symbolp rcirc-fill-column) + (1- (funcall rcirc-fill-column))) + (t rcirc-fill-column)) ;; make sure ... doesn't cause line wrapping 3))) (fill-region (point) (point-max) nil t)))) ------------------------------------------------------------ revno: 118224 author: Ulf Jasper committer: Ulf Jasper branch nick: trunk timestamp: Tue 2014-10-28 21:33:12 +0100 message: xml.c:parse_region: Do not forget the first document child. * src/xml.c (parse_region): Do not forget the first document child. * test/automated/libxml-tests.el: New file. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2014-10-25 13:56:22 +0000 +++ src/ChangeLog 2014-10-28 20:33:12 +0000 @@ -1,3 +1,7 @@ +2014-10-28 Ulf Jasper + + * xml.c (parse_region): Do not forget the first document child. + 2014-10-25 Jan Djärv * nsselect.m: pasteboard_changecount is new. === modified file 'src/xml.c' --- src/xml.c 2014-01-01 07:43:34 +0000 +++ src/xml.c 2014-10-28 20:33:12 +0000 @@ -216,7 +216,7 @@ { /* If the document is just comments, then this should get us the nodes anyway. */ - xmlNode *n = doc->children->next; + xmlNode *n = doc->children; Lisp_Object r = Qnil; while (n) { === modified file 'test/ChangeLog' --- test/ChangeLog 2014-10-25 09:12:01 +0000 +++ test/ChangeLog 2014-10-28 20:33:12 +0000 @@ -1,3 +1,7 @@ +2014-10-28 Ulf Jasper + + * automated/libxml-tests.el: New file. + 2014-10-22 Noam Postavsky * test/automated/process-tests.el (process-test-quoted-batfile): === added file 'test/automated/libxml-tests.el' --- test/automated/libxml-tests.el 1970-01-01 00:00:00 +0000 +++ test/automated/libxml-tests.el 2014-10-28 20:33:12 +0000 @@ -0,0 +1,56 @@ +;;; libxml-parse-tests.el --- Test suite for libxml parsing. + +;; Copyright (C) 2014 Free Software Foundation, Inc. + +;; Author: Ulf Jasper +;; Keywords: internal +;; Human-Keywords: internal + +;; 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: + +;;; Code: + +(require 'ert) + +(defvar libxml-tests--data + `(;; simple case + ("bar" + . (foo ((baz . "true")) "bar")) + ;; toplevel comments -- first document child must not get lost + (,(concat "bar" + "") + . (top nil (foo nil "bar") (comment nil "comment-1") + (comment nil "comment-2"))) + (,(concat "" + "blub") + . (top nil (comment nil "comment-a") (foo ((a . "b")) (bar nil "blub")) + (comment nil "comment-b") (comment nil "comment-c")))) + "Alist of XML strings and their expected parse trees.") + + +(ert-deftest libxml-tests () + "Test libxml." + (when (fboundp 'libxml-parse-xml-region) + (with-temp-buffer + (dolist (test libxml-tests--data) + (erase-buffer) + (insert (car test)) + (should (equal (cdr test) + (libxml-parse-xml-region (point-min) (point-max)))))))) + +;;; libxml-tests.el ends here ------------------------------------------------------------ revno: 118223 committer: Katsumi Yamaoka branch nick: trunk timestamp: Mon 2014-10-27 12:51:18 +0900 message: lisp/gnus/gnus.el (gnus-mode-line-buffer-identification): Don't add image data for a non-graphic display (bug#18813) diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2014-10-24 09:29:09 +0000 +++ lisp/gnus/ChangeLog 2014-10-27 03:51:18 +0000 @@ -1,3 +1,8 @@ +2014-10-27 Katsumi Yamaoka + + * gnus.el (gnus-mode-line-buffer-identification): + Don't add image data for a non-graphic display (bug#18813). + 2014-10-24 Katsumi Yamaoka * gnus.el (gnus-mode-line-buffer-identification): Don't shadow === modified file 'lisp/gnus/gnus.el' --- lisp/gnus/gnus.el 2014-10-24 08:34:32 +0000 +++ lisp/gnus/gnus.el 2014-10-27 03:51:18 +0000 @@ -327,7 +327,8 @@ (defun gnus-mode-line-buffer-identification (line) (let ((str (car-safe line)) (load-path (append (mm-image-load-path) load-path))) - (if (and (stringp str) + (if (and (display-graphic-p) + (stringp str) (string-match "^Gnus:" str)) (progn (add-text-properties 0 5 ------------------------------------------------------------ revno: 118222 committer: Eric S. Raymond branch nick: trunk timestamp: Sun 2014-10-26 20:50:32 -0400 message: Guidance on commit-comment formats. diff: === modified file 'admin/ChangeLog' --- admin/ChangeLog 2014-10-27 00:27:55 +0000 +++ admin/ChangeLog 2014-10-27 00:50:32 +0000 @@ -1,7 +1,8 @@ 2014-10-27 Eric S. Raymond * notes/bzr: Renamed to notes/repo, reorganixed to separate - VCS-dependent from VCS-independent stuff. + VCS-dependent from VCS-independent stuff. Added guidance about + commit-comment format under DVCSes. * notes/BRANCH: Merged into notes/repo. === modified file 'admin/notes/repo' --- admin/notes/repo 2014-10-27 00:27:55 +0000 +++ admin/notes/repo 2014-10-27 00:50:32 +0000 @@ -1,5 +1,23 @@ NOTES ON COMMITTING TO EMACS'S REPOSITORY -*- outline -*- +* Use DVCS commenting conventions + +Commits should follow the conventions used in all modern distributed +version-control systems. That is, they should consist of + +- A self-contained topic line no more than 75 chars long. + +- If other content follows the topic line, there should be + a blank line separating the two. + +Try to keep your commits - and your commit comments - small. If +you feel an urge to put a bullet list in your commit comment, it's +doing too many things at once. + +Yes, these directins are a departure from historical Emacs practice, +but it helps modern log-viewing and summary tools work better so that +other people can comprehend your code. + * Commit to the right branch You can view the available Emacs branches at ------------------------------------------------------------ revno: 118221 committer: Eric S. Raymond branch nick: trunk timestamp: Sun 2014-10-26 20:27:55 -0400 message: More preparation for git tramsition. Reorganize to sparate our dependencies. diff: === modified file 'admin/ChangeLog' --- admin/ChangeLog 2014-10-21 01:17:06 +0000 +++ admin/ChangeLog 2014-10-27 00:27:55 +0000 @@ -1,3 +1,10 @@ +2014-10-27 Eric S. Raymond + + * notes/bzr: Renamed to notes/repo, reorganixed to separate + VCS-dependent from VCS-independent stuff. + + * notes/BRANCH: Merged into notes/repo. + 2014-10-20 Glenn Morris * Merge in all changes up to 24.4 release. === modified file 'admin/notes/repo' --- admin/notes/repo 2014-10-26 11:15:06 +0000 +++ admin/notes/repo 2014-10-27 00:27:55 +0000 @@ -51,15 +51,6 @@ and branch yourself (when committing the branch change, indicate in the commit log that it should not be merged to the trunk; see below). -* Backporting a bug-fix from the trunk to a branch (e.g. "emacs-24"). - -Indicate in the commit log that there is no need to merge the commit -to the trunk. Anything that matches `bzrmerge-skip-regexp' will do; -eg start the commit message with "Backport:". This is helpful for the -person merging the release branch to the trunk. - -http://lists.gnu.org/archive/html/emacs-devel/2010-05/msg00262.html - * Installing changes from your personal branches. If your branch has only a single commit, or many different real @@ -98,6 +89,15 @@ If you remove a gnulib module, or if a gnulib module removes a file, then remove the corresponding files by hand. +* Backporting a bug-fix from the trunk to a branch (e.g. "emacs-24"). + +Indicate in the commit log that there is no need to merge the commit +to the trunk. Anything that matches `bzrmerge-skip-regexp' will do; +eg start the commit message with "Backport:". This is helpful for the +person merging the release branch to the trunk. + +http://lists.gnu.org/archive/html/emacs-devel/2010-05/msg00262.html + * How to merge changes from emacs-24 to trunk The following description uses bound branches, presumably it works in @@ -158,18 +158,6 @@ revisions gets merged, the actual changes themselves do not. http://lists.gnu.org/archive/html/emacs-devel/2011-01/msg00609.html ) -In particular, check the ChangeLog entries (eg in case too many -entries have been included or whitespace between entries needs fixing). -bzrmerge tries to fix up the dates to today's date, but it only does -this where there are conflicts. If you used the changelog_merge plugin, -there won't be any conflicts, and (at time of writing) you will need -to adjust dates by hand. In any case, if someone made multiple -ChangeLog entries on different days in the branch, you may wish to -collapse them all to a single entry for that author in the trunk -(because in the trunk they all appear under the same date). -Obviously, if there are multiple changes to the same file by different -authors, don't break the logical ordering in doing this. - Notes: 1) If a file is modified in emacs-24, and deleted in the trunk, you @@ -178,11 +166,25 @@ trunk version. Prior to bzr 2.2.3, this may fail. You can just delete the .OTHER etc files by hand and use bzr resolve path/to/file. -2) Conflicts in autoload md5sums in comments. Strictly speaking, the -right thing to do is merge everything else, resolve the conflict by -choosing either the trunk or branch version, then run `make -C lisp -autoloads' to update the md5sums to the correct trunk value before -committing. +* Sanity-checking branch merges + +Inspect the ChangeLog entries (e.g. in case too many entries have been +included or whitespace between entries needs fixing). bzrmerge tries +to fix up the dates to today's date, but it only does this where there +are conflicts. If you used the changelog_merge plugin, there won't be +any conflicts, and (at time of writing) you will need to adjust dates +by hand. In any case, if someone made multiple ChangeLog entries on +different days in the branch, you may wish to collapse them all to a +single entry for that author in the trunk (because in the trunk they +all appear under the same date). Obviously, if there are multiple +changes to the same file by different authors, don't break the logical +ordering in doing this. + +You may see conflicts in autoload md5sums in comments. Strictly +speaking, the right thing to do is merge everything else, resolve the +conflict by choosing either the trunk or branch version, then run +`make -C lisp autoloads' to update the md5sums to the correct trunk +value before committing. * Re-adding a file that has been removed from the repository ------------------------------------------------------------ revno: 118220 committer: Eric S. Raymond branch nick: trunk timestamp: Sun 2014-10-26 13:57:10 -0400 message: Fix some fallback values to conform to the actual release number. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-10-25 18:58:44 +0000 +++ lisp/ChangeLog 2014-10-26 17:57:10 +0000 @@ -1,3 +1,8 @@ +2014-10-26 Eric S. Raymond + + * version.el: Fix some fallback values to conform to the actual + release number. + 2014-10-25 Eric S. Raymond * Makefile.in: Change some production names so they're neutral === modified file 'lisp/version.el' --- lisp/version.el 2014-02-10 01:34:22 +0000 +++ lisp/version.el 2014-10-26 17:57:10 +0000 @@ -91,7 +91,7 @@ or if we could not determine the revision.") (define-obsolete-variable-alias 'emacs-bzr-version - 'emacs-repository-version "24.4") + 'emacs-repository-version "25.1") (defun emacs-bzr-version-dirstate (dir) "Try to return as a string the bzr revision ID of directory DIR. @@ -129,7 +129,7 @@ (buffer-string)))) (define-obsolete-function-alias 'emacs-bzr-get-version - 'emacs-repository-get-version "24.4") + 'emacs-repository-get-version "25.1") (defun emacs-repository-get-version (&optional dir external) "Try to return as a string the repository revision of the Emacs sources. ------------------------------------------------------------ revno: 118219 committer: Dani Moncayo branch nick: trunk timestamp: Sun 2014-10-26 18:47:32 +0100 message: * README.W32 (Preliminaries): Don't assume that this file is at the top level. (Setting up Emacs): Minor rewording to be more accurate. diff: === modified file 'nt/ChangeLog' --- nt/ChangeLog 2014-10-25 19:01:09 +0000 +++ nt/ChangeLog 2014-10-26 17:47:32 +0000 @@ -1,3 +1,9 @@ +2014-10-26 Dani Moncayo + + * README.W32 (Preliminaries): Don't assume that this file is at + the top level. + (Setting up Emacs): Minor rewording to be more accurate. + 2014-10-25 Eric S. Raymond * Neutralize language specific to a repository type. === modified file 'nt/README.W32' --- nt/README.W32 2014-10-09 00:47:30 +0000 +++ nt/README.W32 2014-10-26 17:47:32 +0000 @@ -21,13 +21,16 @@ * Preliminaries - Along with this file should be four subdirectories (bin, libexec, - share, and var). + The binary distribution has these top-level directories: + + bin + + libexec + + share + + var * Setting up Emacs - To install Emacs, simply unpack all the files into a directory of - your choice. To complete the installation process, you can + To install Emacs, simply unpack the binary package into a directory + of your choice. To complete the installation process, you can optionally run the program addpm.exe in the bin subdirectory. This will put an icon for Emacs in the Start Menu under "Start -> Programs -> Gnu Emacs". ------------------------------------------------------------ revno: 118218 committer: Eric S. Raymond branch nick: trunk timestamp: Sun 2014-10-26 11:54:03 -0400 message: Neutralize language specific to a VCS type. diff: === modified file 'autogen.sh' --- autogen.sh 2014-10-25 18:51:54 +0000 +++ autogen.sh 2014-10-26 15:54:03 +0000 @@ -145,7 +145,7 @@ cat < branch nick: trunk timestamp: Sun 2014-10-26 11:43:38 -0400 message: Neutralize labguage specific to a VCS type. diff: === modified file 'doc/misc/efaq.texi' --- doc/misc/efaq.texi 2014-06-10 02:20:31 +0000 +++ doc/misc/efaq.texi 2014-10-26 15:43:38 +0000 @@ -982,10 +982,8 @@ version (e.g., @samp{23.0.50} is what will eventually become @samp{23.1}). Emacs is under active development, hosted at -@uref{http://savannah.gnu.org/projects/emacs/, Savannah}. The source -code can be retrieved anonymously following the -@uref{http://savannah.gnu.org/bzr/?group=emacs, instructions}. -The repository is GNU Bazaar. +@uref{http://savannah.gnu.org/projects/emacs/, Savannah}. +Follow the instructions given there to clone the project repository. Because Emacs undergoes many changes before a release, the version number of a development version is not especially meaningful. It is ------------------------------------------------------------ revno: 118216 committer: Eric S. Raymond branch nick: trunk timestamp: Sun 2014-10-26 11:38:44 -0400 message: Neutralized language specific to a repository type. diff: === modified file 'doc/misc/ChangeLog' --- doc/misc/ChangeLog 2014-10-25 19:23:20 +0000 +++ doc/misc/ChangeLog 2014-10-26 15:38:44 +0000 @@ -1,3 +1,7 @@ +2014-10-26 Eric S. Raymond + + * efaq-w32.texi: Neutralized language specific to a repository type. + 2014-10-25 Eric S. Raymond * gnus-coding.txt: Neutralized language specific to a repository type. === modified file 'doc/misc/efaq-w32.texi' --- doc/misc/efaq-w32.texi 2014-06-10 02:20:31 +0000 +++ doc/misc/efaq-w32.texi 2014-10-26 15:38:44 +0000 @@ -176,7 +176,7 @@ distributed as a compressed tar file, digitally signed by the maintainer who made the release. -@cindex Bzr, getting Emacs +@cindex getting Emacs @cindex latest development version of Emacs @cindex Emacs Development The development version of Emacs is available from @@ -199,8 +199,8 @@ equivalents are not consistent between versions. GNU texinfo will be required to build the manuals. @xref{Other useful ports}. -After unpacking the source, or checking out of Bzr, be sure to read the -instructions in @file{nt/README} and @file{nt/INSTALL}. +After unpacking the source, or checking out of the repository, be sure +to read the instructions in @file{nt/README} and @file{nt/INSTALL}. @node Debugging @section How do I use a debugger on Emacs? ------------------------------------------------------------ revno: 118215 committer: Eric S. Raymond branch nick: trunk timestamp: Sun 2014-10-26 07:15:06 -0400 message: Merge BRANCH into repo, because it belongs with the developer advice. Also... ...this helps prepare for the repository move. diff: === removed file 'admin/notes/BRANCH' --- admin/notes/BRANCH 2011-03-08 00:08:03 +0000 +++ admin/notes/BRANCH 1970-01-01 00:00:00 +0000 @@ -1,32 +0,0 @@ -You can view the available Emacs branches at - -http://bzr.savannah.gnu.org/r/emacs/ - -Development normally takes places on the trunk. -Sometimes specialized features are developed on separate branches -before possibly being merged to the trunk. - -Development is discussed on the emacs-devel mailing list. - -Sometime before the release of a new major version of Emacs (eg 23.2), -a "feature freeze" is imposed on the trunk. No new features may be -added after this point. This is usually some months before the release. - -Shortly before the release, a release branch is created, and the -trunk is then free for development. -For example, "emacs-23" for Emacs 23.2 and later, "EMACS_23_1_RC" for -23.1, "EMACS_22_BASE" for 22.x, and "EMACS_21_1_RC" for 21.x. - -Consult emacs-devel for exactly what kinds of changes are allowed -on what branch at any time. - -If you are looking at this file in a branch other than the trunk, -there may be some branch-specific documentation below this line. -________________________________________________________________________ - -* elpa - - This branch does not contain a copy of Emacs, but of the Emacs Lisp - package archive (elpa.gnu.org). See admin/notes/elpa for further - explanation, and the README file in the branch for usage - instructions. === modified file 'admin/notes/repo' --- admin/notes/repo 2014-10-26 10:12:44 +0000 +++ admin/notes/repo 2014-10-26 11:15:06 +0000 @@ -1,6 +1,39 @@ NOTES ON COMMITTING TO EMACS'S REPOSITORY -*- outline -*- +* Commit to the right branch + +You can view the available Emacs branches at + +http://bzr.savannah.gnu.org/r/emacs/ + +Development normally takes places on the trunk. +Sometimes specialized features are developed on separate branches +before possibly being merged to the trunk. + +Development is discussed on the emacs-devel mailing list. + +Sometime before the release of a new major version of Emacs +a "feature freeze" is imposed on the trunk. No new features may be +added after this point. This is usually some months before the release. + +Shortly before the release, a release branch is created, and the +trunk is then free for development. + +For example, "emacs-23" for Emacs 23.2 and later, "EMACS_23_1_RC" for +23.1, "EMACS_22_BASE" for 22.x, and "EMACS_21_1_RC" for 21.x. + +Consult emacs-devel for exactly what kinds of changes are allowed +on what branch at any time. + +** elpa + +This branch does not contain a copy of Emacs, but of the Emacs Lisp +package archive (elpa.gnu.org). See admin/notes/elpa for further +explanation, and the README file in the branch for usage +instructions. + * Install changes only on one branch, let them get merged elsewhere if needed. + In particular, install bug-fixes only on the release branch (if there is one) and let them get synced to the trunk; do not install them by hand on the trunk as well. E.g. if there is an active "emacs-24" branch @@ -19,6 +52,7 @@ in the commit log that it should not be merged to the trunk; see below). * Backporting a bug-fix from the trunk to a branch (e.g. "emacs-24"). + Indicate in the commit log that there is no need to merge the commit to the trunk. Anything that matches `bzrmerge-skip-regexp' will do; eg start the commit message with "Backport:". This is helpful for the @@ -27,6 +61,7 @@ http://lists.gnu.org/archive/html/emacs-devel/2010-05/msg00262.html * Installing changes from your personal branches. + If your branch has only a single commit, or many different real commits, it is fine to do a merge. If your branch has only a very small number of "real" commits, but several "merge from trunks", it is @@ -47,6 +82,7 @@ http://lists.gnu.org/archive/html/emacs-devel/2010-04/msg00086.html * Installing changes from gnulib + Some of the files in Emacs are copied from gnulib. To synchronize these files from the version of gnulib that you have checked out into a sibling directory of your branch, type "admin/merge-gnulib"; this ------------------------------------------------------------ revno: 118214 committer: Eric S. Raymond branch nick: trunk timestamp: Sun 2014-10-26 07:01:58 -0400 message: Neutralize some language specific to a repository type. diff: === modified file 'admin/notes/years' --- admin/notes/years 2013-12-25 23:25:32 +0000 +++ admin/notes/years 2014-10-26 11:01:58 +0000 @@ -2,7 +2,7 @@ Maintaining copyright years is now very simple: every time a new year rolls around, add that year to every FSF (and AIST) copyright notice. -Do this by running the 'admin/update-copyright' script on a fresh bzr +Do this by running the 'admin/update-copyright' script on a fresh repo checkout. Inspect the results for plausibility, then commit them. There's no need to worry about whether an individual file has changed ------------------------------------------------------------ revno: 118213 committer: Eric S. Raymond branch nick: trunk timestamp: Sun 2014-10-26 06:12:44 -0400 message: Rename the 'bzr' notes file to 'repo'. For two reasons: 1. A significant portion of the advice is independent of any specific version-control sytem. 2. Doing the rename now means it is easier to compose a multi-file patch that can be applied to fix the tree on the day of the git move. diff: === renamed file 'admin/notes/bzr' => 'admin/notes/repo' --- admin/notes/bzr 2014-09-04 00:40:03 +0000 +++ admin/notes/repo 2014-10-26 10:12:44 +0000 @@ -1,4 +1,4 @@ -NOTES ON COMMITTING TO EMACS'S BAZAAR REPO -*- outline -*- +NOTES ON COMMITTING TO EMACS'S REPOSITORY -*- outline -*- * Install changes only on one branch, let them get merged elsewhere if needed. In particular, install bug-fixes only on the release branch (if there ------------------------------------------------------------ revno: 118212 committer: Eric S. Raymond branch nick: trunk timestamp: Sat 2014-10-25 16:11:24 -0400 message: Looking for .bzr as a check for top-level directory will soon be a bad idea. Fortunately the other two checks should be quite sufficient. diff: === modified file 'admin/check-doc-strings' --- admin/check-doc-strings 2014-01-02 08:47:40 +0000 +++ admin/check-doc-strings 2014-10-25 20:11:24 +0000 @@ -18,7 +18,7 @@ This program is in the public domain.\n"; die $usage if @ARGV; -die $usage unless -r "src/alloc.c" && -d ".bzr" && -d "lisp"; +die $usage unless -r "src/alloc.c" && -d "lisp"; my %texi_funtype; my %texi_arglist; ------------------------------------------------------------ revno: 118211 committer: Eric S. Raymond branch nick: trunk timestamp: Sat 2014-10-25 15:53:26 -0400 message: Neutralize some production names specific to a repository type. diff: === modified file 'lisp/makefile.w32-in' --- lisp/makefile.w32-in 2014-01-01 07:43:34 +0000 +++ lisp/makefile.w32-in 2014-10-25 19:53:26 +0000 @@ -257,11 +257,11 @@ updates: $(lisp)/subdirs.el autoloads mh-autoloads finder-data custom-deps -# This is useful after "bzr up". -bzr-update: recompile autoloads finder-data custom-deps +# This is useful after a repository fetch. +repo-update: recompile autoloads finder-data custom-deps # For backwards compatibility: -cvs-update: bzr-update +cvs-update: repo-update # Update the AUTHORS file. ------------------------------------------------------------ revno: 118210 committer: Eric S. Raymond branch nick: trunk timestamp: Sat 2014-10-25 15:36:23 -0400 message: Preparing foe git transition. diff: === modified file 'admin/update-copyright' --- admin/update-copyright 2014-01-01 07:43:34 +0000 +++ admin/update-copyright 2014-10-25 19:36:23 +0000 @@ -45,14 +45,15 @@ } && rm $emacsver.aux && -bzr_files=$(bzr ls -RV --kind file) && +# FIXME: command will soon need to be replaced with "git ls-files" +repo_files=$(bzr ls -RV --kind file) && # Do not update the copyright of files that have one or more of the # following problems: # . They are license files, maintained by the FSF, with their own dates. # . Their format cannot withstand changing the contents of copyright strings. -updatable_files=$(find $bzr_files \ +updatable_files=$(find $repo_files \ ! -name COPYING \ ! -name doclicense.texi \ ! -name gpl.texi \ ------------------------------------------------------------ revno: 118209 committer: Eric S. Raymond branch nick: trunk timestamp: Sat 2014-10-25 15:24:12 -0400 message: Next binary distribution will not contain .bzrignore files. Removing this now to unclitter the grwp listings when I hunt for obsolete references to bzr. diff: === modified file 'nt/zipdist.bat' --- nt/zipdist.bat 2014-01-01 07:43:34 +0000 +++ nt/zipdist.bat 2014-10-25 19:24:12 +0000 @@ -36,7 +36,7 @@ rem Build and verify the binary distribution :ZIP_DIST -7z a -bd -tZIP -mx=9 -x!.bzrignore -x!.gitignore -xr!emacs.mdp -xr!*.pdb -xr!*.opt -xr!*~ -xr!CVS -xr!.arch-inventory emacs-%EMACS_VER%-bin-i386.zip %TMP_DIST_DIR% +7z a -bd -tZIP -mx=9 -x!.gitignore -xr!emacs.mdp -xr!*.pdb -xr!*.opt -xr!*~ -xr!CVS -xr!.arch-inventory emacs-%EMACS_VER%-bin-i386.zip %TMP_DIST_DIR% 7z t emacs-%EMACS_VER%-bin-i386.zip goto EXIT ------------------------------------------------------------ revno: 118208 committer: Eric S. Raymond branch nick: trunk timestamp: Sat 2014-10-25 15:23:20 -0400 message: Neutralize language specific to a repository type. diff: === modified file 'doc/misc/ChangeLog' --- doc/misc/ChangeLog 2014-10-21 01:17:06 +0000 +++ doc/misc/ChangeLog 2014-10-25 19:23:20 +0000 @@ -1,3 +1,7 @@ +2014-10-25 Eric S. Raymond + + * gnus-coding.txt: Neutralized language specific to a repository type. + 2014-10-20 Glenn Morris * Merge in all changes up to 24.4 release. === modified file 'doc/misc/gnus-coding.texi' --- doc/misc/gnus-coding.texi 2014-06-10 02:20:31 +0000 +++ doc/misc/gnus-coding.texi 2014-10-25 19:23:20 +0000 @@ -313,17 +313,17 @@ new @file{encrypt.el}), you should probably make the change in the Emacs tree, and it will show up in the Gnus tree a few days later. -If you don't have Emacs bzr access (or it's inconvenient), you can -change such a file in the v5-10 branch, and it should propagate to Emacs -bzr---however, it will get some extra scrutiny (by Miles) to see if the -changes are possibly controversial and need discussion on the mailing -list. Many changes are obvious bug-fixes however, so often there won't -be any problem. +If you don't have Emacs repository access (or it's inconvenient), you +can change such a file in the v5-10 branch, and it should propagate to +the Emacs repository---however, it will get some extra scrutiny (by +Miles) to see if the changes are possibly controversial and need +discussion on the mailing list. Many changes are obvious bug-fixes +however, so often there won't be any problem. @item If it's to a Gnus file, and it's important enough that it should be part of Emacs and the v5-10 branch, then you can make the change on the v5-10 -branch, and it will go into Emacs bzr and the Gnus git trunk (a few days +branch, and it will go into Emacs and the Gnus git trunk (a few days later). The most prominent examples for such changes are bug-fixed including improvements on the documentation. ------------------------------------------------------------ revno: 118207 committer: Eric S. Raymond branch nick: trunk timestamp: Sat 2014-10-25 15:21:11 -0400 message: Anticipatory removal of some test data that will be obsolete shortly. diff: === modified file 'test/automated/thingatpt.el' --- test/automated/thingatpt.el 2014-01-01 07:43:34 +0000 +++ test/automated/thingatpt.el 2014-10-25 19:21:11 +0000 @@ -26,7 +26,6 @@ ("http://2.gnu.org" 6 url "http://2.gnu.org") ("http://3.gnu.org" 19 url "http://3.gnu.org") ("https://4.gnu.org" 1 url "https://4.gnu.org") - ("bzr://savannah.gnu.org" 1 url "bzr://savannah.gnu.org") ("A geo URI (geo:3.14159,-2.71828)." 12 url "geo:3.14159,-2.71828") ("Visit http://5.gnu.org now." 5 url nil) ("Visit http://6.gnu.org now." 7 url "http://6.gnu.org") ------------------------------------------------------------ revno: 118206 committer: Eric S. Raymond branch nick: trunk timestamp: Sat 2014-10-25 15:01:09 -0400 message: Neutralize language specific to a repository type. diff: === modified file 'nt/ChangeLog' --- nt/ChangeLog 2014-10-25 09:12:01 +0000 +++ nt/ChangeLog 2014-10-25 19:01:09 +0000 @@ -1,3 +1,7 @@ +2014-10-25 Eric S. Raymond + + * Neutralize language specific to a repository type. + 2014-10-22 Noam Postavsky * nt/cmdproxy.c (batch_file_p): New function. === modified file 'nt/INSTALL' --- nt/INSTALL 2014-06-08 00:35:27 +0000 +++ nt/INSTALL 2014-10-25 19:01:09 +0000 @@ -169,7 +169,7 @@ you are building from the repository: . Texinfo (needed to produce the Info manuals when building from - bzr/git, and for "make install") + the repository, and for "make install") Available from http://sourceforge.net/projects/ezwinports/files/. === modified file 'nt/INSTALL.OLD' --- nt/INSTALL.OLD 2014-01-01 07:43:34 +0000 +++ nt/INSTALL.OLD 2014-10-25 19:01:09 +0000 @@ -126,7 +126,7 @@ http://sourceforge.net/projects/ezwinports/files/ In addition to this file, if you build a development snapshot, you - should also read INSTALL.BZR in the parent directory. + should also read INSTALL.REPO in the parent directory. * Supported development environments @@ -575,7 +575,7 @@ * Creating binary distributions Binary distributions (full and barebin distributions) can be - automatically built and packaged from source tarballs or a bzr + automatically built and packaged from source tarballs or a repository checkout. When building Emacs binary distributions, the --distfiles argument ------------------------------------------------------------ revno: 118205 committer: Eric S. Raymond branch nick: trunk timestamp: Sat 2014-10-25 14:58:44 -0400 message: Neutralize language specific to a repository type. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-10-25 13:29:15 +0000 +++ lisp/ChangeLog 2014-10-25 18:58:44 +0000 @@ -1,3 +1,8 @@ +2014-10-25 Eric S. Raymond + + * Makefile.in: Change some production names so they're neutral + about the repository type. + 2014-10-25 Michael Albinus * net/tramp-gvfs.el (tramp-gvfs-methods-mounttracker) ------------------------------------------------------------ revno: 118204 committer: Eric S. Raymond branch nick: trunk timestamp: Sat 2014-10-25 14:57:20 -0400 message: Neutralize language specific to a repository type. diff: === modified file 'lisp/man.el' --- lisp/man.el 2014-07-02 00:57:53 +0000 +++ lisp/man.el 2014-10-25 18:57:20 +0000 @@ -837,7 +837,7 @@ foo(sec)[, bar(sec) [, ...]] [other stuff] - description For more details and some regression tests, please see -test/automated/man-tests.el in the emacs bzr repository." +test/automated/man-tests.el in the emacs repository." (goto-char (point-min)) ;; See man-tests for data about which systems use which format (hopefully we ;; will be able to simplify the code if/when some of those formats aren't ------------------------------------------------------------ revno: 118203 committer: Eric S. Raymond branch nick: trunk timestamp: Sat 2014-10-25 14:55:59 -0400 message: Neutralize names specific to a repository type. diff: === modified file 'lisp/Makefile.in' --- lisp/Makefile.in 2014-10-06 14:12:56 +0000 +++ lisp/Makefile.in 2014-10-25 18:55:59 +0000 @@ -196,18 +196,18 @@ $(srcdir)/../build-aux/update-subdirs $$file; \ done; -.PHONY: updates bzr-update update-authors +.PHONY: updates repo-update update-authors # Some modes of make-dist use this. updates: update-subdirs autoloads finder-data custom-deps -# This is useful after "bzr up"; but it doesn't do anything that a +# This is useful after a repostiory fetch; but it doesn't do anything that a # plain "make" at top-level doesn't. # The only difference between this and this directory's "all" rule # is that this runs "autoloads" as well (because it uses "compile" # rather than "compile-main"). In a bootstrap, $(lisp) in src/Makefile # triggers this directory's autoloads rule. -bzr-update: compile finder-data custom-deps +repo-update: compile finder-data custom-deps # Update the AUTHORS file. ------------------------------------------------------------ revno: 118202 committer: Eric S. Raymond branch nick: trunk timestamp: Sat 2014-10-25 14:53:20 -0400 message: Neutralize language specific to a repository type. diff: === modified file 'admin/notes/hydra' --- admin/notes/hydra 2014-01-01 07:43:34 +0000 +++ admin/notes/hydra 2014-10-25 18:53:20 +0000 @@ -26,7 +26,7 @@ * The Emacs jobset consists of the following jobs: ** The `tarball' job -which gets a checkout from bzr, and does a bootstrap followed +which gets a checkout from the repository, and does a bootstrap followed by running make-dist to create a tarball. If this job fails, all the others will too (because they use the tarball as input). ------------------------------------------------------------ revno: 118201 committer: Eric S. Raymond branch nick: trunk timestamp: Sat 2014-10-25 14:51:54 -0400 message: Neutralize language specific to a repository type. diff: === modified file 'ChangeLog' --- ChangeLog 2014-10-23 06:31:48 +0000 +++ ChangeLog 2014-10-25 18:51:54 +0000 @@ -1,3 +1,7 @@ +2014-10-25 Eric S. Raymond + + * autogen.sh: Neutralize language specific to a repository type. + 2014-10-23 Paul Eggert * Makefile.in (ACLOCAL_INPUTS): Omit unnecessary use of 'wildcard'. === modified file 'autogen.sh' --- autogen.sh 2014-05-16 15:49:13 +0000 +++ autogen.sh 2014-10-25 18:51:54 +0000 @@ -1,5 +1,5 @@ #!/bin/sh -### autogen.sh - tool to help build Emacs from a bzr checkout +### autogen.sh - tool to help build Emacs from a repository checkout ## Copyright (C) 2011-2014 Free Software Foundation, Inc. @@ -23,8 +23,8 @@ ### Commentary: -## The Emacs bzr repository does not include the configure script -## (and associated helpers). The first time you fetch Emacs from bzr, +## The Emacs repository does not include the configure script (and +## associated helpers). The first time you fetch Emacs from the repo, ## run this script to generate the necessary files. ## For more details, see the file INSTALL.REPO. ------------------------------------------------------------ revno: 118200 committer: Eric S. Raymond branch nick: trunk timestamp: Sat 2014-10-25 14:48:49 -0400 message: Preparing for git transition; replace bzr-specific language. diff: === modified file 'admin/notes/copyright' --- admin/notes/copyright 2014-08-09 16:12:33 +0000 +++ admin/notes/copyright 2014-10-25 18:48:49 +0000 @@ -24,7 +24,7 @@ 2. When installing code written by someone else, the ChangeLog entry should be in the name of the author of the code, not the person who -installs it. Also use bzr commit's "--author" option. +installs it. Also use commit's "--author" option. Do not install any of your own changes in the same commit. 3. With images, add the legal info to a README file in the directory @@ -484,10 +484,10 @@ obviously good): -Is it OK to just `bzr remove' a file for legal reasons, or is -something more drastic needed? A removed file is still available from -the repository, if suitable options are applied. (This issue obviously -does not affect a release). +Is it OK to just remove a file for legal reasons, or is something more +drastic (excision from the entire repository history) needed? A +removed file is still available from the repository, if suitable +options are applied. (This issue obviously does not affect a release). rms: will ask lawyer ------------------------------------------------------------ revno: 118199 fixes bug: http://debbugs.gnu.org/18799 committer: Jan D. branch nick: trunk timestamp: Sat 2014-10-25 15:56:22 +0200 message: * nsselect.m: pasteboard_changecount is new. (ns_store_pb_change_count, ns_get_pb_change_count) (ns_get_our_change_count_for): New functions. (ns_string_to_pasteboard_internal): Correct comment. type => gtype in eassert, Call ns_store_pb_change_count. (Fns_own_selection_internal): Remove data, use value. (Fns_disown_selection_internal, Fns_selection_owner_p): Replace Vselection_alist check, with change count check. (Fns_get_selection): Initialize val to Qnil. Only get local selection if change counts match (Bug#18799). (nxatoms_of_nsselect): Initialize pasteboard_changecount. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2014-10-25 09:12:01 +0000 +++ src/ChangeLog 2014-10-25 13:56:22 +0000 @@ -1,3 +1,17 @@ +2014-10-25 Jan Djärv + + * nsselect.m: pasteboard_changecount is new. + (ns_store_pb_change_count, ns_get_pb_change_count) + (ns_get_our_change_count_for): New functions. + (ns_string_to_pasteboard_internal): Correct comment. + type => gtype in eassert, Call ns_store_pb_change_count. + (Fns_own_selection_internal): Remove data, use value (Bug#18799). + (Fns_disown_selection_internal, Fns_selection_owner_p): Replace + Vselection_alist check, with change count check. + (Fns_get_selection): Initialize val to Qnil. Only get local + selection if change counts match (Bug#18799). + (nxatoms_of_nsselect): Initialize pasteboard_changecount. + 2014-10-25 Noam Postavsky * src/w32proc.c (create_child): If calling a quoted batch file, === modified file 'src/nsselect.m' --- src/nsselect.m 2014-10-21 15:27:18 +0000 +++ src/nsselect.m 2014-10-25 13:56:22 +0000 @@ -45,6 +45,7 @@ NSString *NXSecondaryPboard; +static NSMutableDictionary *pasteboard_changecount; /* ========================================================================== @@ -140,6 +141,29 @@ [pb declareTypes: [NSArray array] owner: nil]; } +static void +ns_store_pb_change_count (id pb) +{ + [pasteboard_changecount + setObject: [NSNumber numberWithLong: [pb changeCount]] + forKey: [pb name]]; +} + +static NSInteger +ns_get_pb_change_count (Lisp_Object selection) +{ + id pb = ns_symbol_to_pb (selection); + return pb != nil ? [pb changeCount] : -1; +} + +static NSInteger +ns_get_our_change_count_for (Lisp_Object selection) +{ + NSNumber *num = [pasteboard_changecount + objectForKey: symbol_to_nsstring (selection)]; + return num != nil ? (NSInteger)[num longValue] : -1; +} + static void ns_string_to_pasteboard_internal (id pb, Lisp_Object str, NSString *gtype) @@ -164,7 +188,7 @@ // FIXME: Why those 2 different code paths? if (gtype == nil) { - // Used for ns-store-selection-internal. + // Used for ns_string_to_pasteboard [pb declareTypes: ns_send_types owner: nil]; tenum = [ns_send_types objectEnumerator]; while ( (type = [tenum nextObject]) ) @@ -173,10 +197,11 @@ else { // Used for ns-own-selection-internal. - eassert (type == NSStringPboardType); + eassert (gtype == NSStringPboardType); [pb setString: nsStr forType: gtype]; } [nsStr release]; + ns_store_pb_change_count (pb); } } @@ -340,7 +365,7 @@ id pb; NSString *type; Lisp_Object successful_p = Qnil, rest; - Lisp_Object target_symbol, data; + Lisp_Object target_symbol; check_window_system (NULL); CHECK_SYMBOL (selection); @@ -363,11 +388,9 @@ /* We only support copy of text. */ type = NSStringPboardType; target_symbol = ns_string_to_symbol (type); - data = ns_get_local_selection (selection, target_symbol); - if (!NILP (data)) + if (STRINGP (value)) { - if (STRINGP (data)) - ns_string_to_pasteboard_internal (pb, data, type); + ns_string_to_pasteboard_internal (pb, value, type); successful_p = Qt; } @@ -391,7 +414,10 @@ id pb; check_window_system (NULL); CHECK_SYMBOL (selection); - if (NILP (assq_no_quit (selection, Vselection_alist))) return Qnil; + + if (ns_get_pb_change_count (selection) + != ns_get_our_change_count_for (selection)) + return Qnil; pb = ns_symbol_to_pb (selection); if (pb != nil) ns_undeclare_pasteboard (pb); @@ -450,7 +476,8 @@ CHECK_SYMBOL (selection); if (EQ (selection, Qnil)) selection = QPRIMARY; if (EQ (selection, Qt)) selection = QSECONDARY; - return (NILP (Fassq (selection, Vselection_alist))) ? Qnil : Qt; + return ns_get_pb_change_count (selection) + == ns_get_our_change_count_for (selection); } @@ -472,12 +499,15 @@ (Lisp_Object selection_name, Lisp_Object target_type, Lisp_Object time_stamp, Lisp_Object terminal) { - Lisp_Object val; + Lisp_Object val = Qnil; check_window_system (NULL); CHECK_SYMBOL (selection_name); CHECK_SYMBOL (target_type); - val = ns_get_local_selection (selection_name, target_type); + + if (ns_get_pb_change_count (selection_name) + == ns_get_our_change_count_for (selection_name)) + val = ns_get_local_selection (selection_name, target_type); if (NILP (val)) val = ns_get_foreign_selection (selection_name, target_type); if (CONSP (val) && SYMBOLP (Fcar (val))) @@ -496,6 +526,18 @@ { NXPrimaryPboard = @"Selection"; NXSecondaryPboard = @"Secondary"; + + // This is a memory loss, never released. + pasteboard_changecount = + [[NSMutableDictionary + dictionaryWithObjectsAndKeys: + [NSNumber numberWithLong:0], NSGeneralPboard, + [NSNumber numberWithLong:0], NXPrimaryPboard, + [NSNumber numberWithLong:0], NXSecondaryPboard, + [NSNumber numberWithLong:0], NSStringPboardType, + [NSNumber numberWithLong:0], NSFilenamesPboardType, + [NSNumber numberWithLong:0], NSTabularTextPboardType, + nil] retain]; } void ------------------------------------------------------------ revno: 118198 fixes bug: http://debbugs.gnu.org/18774 committer: Michael Albinus branch nick: trunk timestamp: Sat 2014-10-25 15:29:15 +0200 message: * net/tramp-gvfs.el (tramp-gvfs-methods-mounttracker) (tramp-gvfs-mountlocation-signature): Check `tramp-gvfs-enabled' during initialization. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-10-25 10:40:14 +0000 +++ lisp/ChangeLog 2014-10-25 13:29:15 +0000 @@ -1,3 +1,9 @@ +2014-10-25 Michael Albinus + + * net/tramp-gvfs.el (tramp-gvfs-methods-mounttracker) + (tramp-gvfs-mountlocation-signature): Check `tramp-gvfs-enabled' + during initialization. (Bug#18774) + 2014-10-25 Vincent Belaïche * ses.el (macroexp): add require for this package, so that === modified file 'lisp/net/tramp-gvfs.el' --- lisp/net/tramp-gvfs.el 2014-09-14 09:00:11 +0000 +++ lisp/net/tramp-gvfs.el 2014-10-25 13:29:15 +0000 @@ -167,9 +167,10 @@ ;; Introspection data exist since GVFS 1.14. If there are no such ;; data, we expect an earlier interface. (defconst tramp-gvfs-methods-mounttracker - (dbus-introspect-get-method-names - :session tramp-gvfs-service-daemon tramp-gvfs-path-mounttracker - tramp-gvfs-interface-mounttracker) + (and tramp-gvfs-enabled + (dbus-introspect-get-method-names + :session tramp-gvfs-service-daemon tramp-gvfs-path-mounttracker + tramp-gvfs-interface-mounttracker)) "The list of supported methods of the mount tracking interface.") (defconst tramp-gvfs-listmounts @@ -187,9 +188,10 @@ It has been changed in GVFS 1.14.") (defconst tramp-gvfs-mountlocation-signature - (dbus-introspect-get-signature - :session tramp-gvfs-service-daemon tramp-gvfs-path-mounttracker - tramp-gvfs-interface-mounttracker tramp-gvfs-mountlocation) + (and tramp-gvfs-enabled + (dbus-introspect-get-signature + :session tramp-gvfs-service-daemon tramp-gvfs-path-mounttracker + tramp-gvfs-interface-mounttracker tramp-gvfs-mountlocation)) "The D-Bus signature of the \"mountLocation\" method. It has been changed in GVFS 1.14.") ------------------------------------------------------------ revno: 118197 committer: Vincent Bela?che branch nick: trunk timestamp: Sat 2014-10-25 12:40:14 +0200 message: * ses.el (macroexp): add require for this package, so that function `ses--cell' gets macroexp-quote --- this change was supposed to be in my previous commit, but left out by mistake. (ses--cell): Do not make formula a macroexp-quote of value when value, not formula, is *skip*. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-10-24 23:02:25 +0000 +++ lisp/ChangeLog 2014-10-25 10:40:14 +0000 @@ -1,3 +1,11 @@ +2014-10-25 Vincent Belaïche + + * ses.el (macroexp): add require for this package, so that + function `ses--cell' gets macroexp-quote --- this change was + supposed to be in my previous commit, but left out by mistake. + (ses--cell): Do not make formula a macroexp-quote of value when + value, not formula, is *skip*. + 2014-10-24 Vincent Belaïche * ses.el (macroexp): add require for this package, so that function === modified file 'lisp/ses.el' --- lisp/ses.el 2014-10-24 23:02:25 +0000 +++ lisp/ses.el 2014-10-25 10:40:14 +0000 @@ -56,6 +56,7 @@ ;;; Code: (require 'unsafep) +(require 'macroexp) (eval-when-compile (require 'cl-lib)) @@ -491,7 +492,7 @@ (let ((rowcol (ses-sym-rowcol sym))) (ses-formula-record formula) (ses-printer-record printer) - (unless (or formula (eq formula '*skip*)) + (unless (or formula (eq value '*skip*)) (setq formula (macroexp-quote value))) (or (atom formula) (eq safe-functions t) ------------------------------------------------------------ revno: 118196 fixes bug: http://debbugs.gnu.org/18745 author: Noam Postavsky committer: Eli Zaretskii branch nick: trunk timestamp: Sat 2014-10-25 12:12:01 +0300 message: Fix bug #18745 with invoking Windows batch files with embedded whitespace. src/w32proc.c (create_child): If calling a quoted batch file, pass NULL for exe. nt/cmdproxy.c (batch_file_p): New function. (spawn): If calling a quoted batch file pass NULL for progname. test/automated/process-tests.el (process-test-quoted-batfile): New test. diff: === modified file 'nt/ChangeLog' --- nt/ChangeLog 2014-10-20 19:59:41 +0000 +++ nt/ChangeLog 2014-10-25 09:12:01 +0000 @@ -1,3 +1,9 @@ +2014-10-22 Noam Postavsky + + * nt/cmdproxy.c (batch_file_p): New function. + (spawn): If calling a quoted batch file pass NULL for progname. + (Bug#18745) + 2014-10-20 Glenn Morris * Merge in all changes up to 24.4 release. === modified file 'nt/cmdproxy.c' --- nt/cmdproxy.c 2014-04-26 07:06:33 +0000 +++ nt/cmdproxy.c 2014-10-25 09:12:01 +0000 @@ -220,6 +220,28 @@ return o - buf; } +/* Return TRUE if PROGNAME is a batch file. */ +BOOL +batch_file_p (const char *progname) +{ + const char *exts[] = {".bat", ".cmd"}; + int n_exts = sizeof (exts) / sizeof (char *); + int i; + + const char *ext = strrchr (progname, '.'); + + if (ext) + { + for (i = 0; i < n_exts; i++) + { + if (stricmp (ext, exts[i]) == 0) + return TRUE; + } + } + + return FALSE; +} + /* Search for EXEC file in DIR. If EXEC does not have an extension, DIR is searched for EXEC with the standard extensions appended. */ int @@ -470,6 +492,13 @@ memset (&start, 0, sizeof (start)); start.cb = sizeof (start); + /* CreateProcess handles batch files as progname specially. This + special handling fails when both the batch file and arguments are + quoted. We pass NULL as progname to avoid the special + handling. */ + if (progname != NULL && cmdline[0] == '"' && batch_file_p (progname)) + progname = NULL; + if (CreateProcess (progname, cmdline, &sec_attrs, NULL, TRUE, 0, envblock, dir, &start, &child)) { === modified file 'src/ChangeLog' --- src/ChangeLog 2014-10-24 13:19:21 +0000 +++ src/ChangeLog 2014-10-25 09:12:01 +0000 @@ -1,3 +1,8 @@ +2014-10-25 Noam Postavsky + + * src/w32proc.c (create_child): If calling a quoted batch file, + pass NULL for exe. (Bug#18745) + 2014-10-24 Eli Zaretskii * bidi.c (bidi_resolve_explicit, bidi_find_bracket_pairs) === modified file 'src/w32proc.c' --- src/w32proc.c 2014-10-01 15:18:16 +0000 +++ src/w32proc.c 2014-10-25 09:12:01 +0000 @@ -1078,6 +1078,7 @@ DWORD flags; char dir[ MAX_PATH ]; char *p; + const char *ext; if (cp == NULL) emacs_abort (); @@ -1116,6 +1117,15 @@ if (*p == '/') *p = '\\'; + /* CreateProcess handles batch files as exe specially. This special + handling fails when both the batch file and arguments are quoted. + We pass NULL as exe to avoid the special handling. */ + if (exe && cmdline[0] == '"' && + (ext = strrchr (exe, '.')) && + (xstrcasecmp (ext, ".bat") == 0 + || xstrcasecmp (ext, ".cmd") == 0)) + exe = NULL; + flags = (!NILP (Vw32_start_process_share_console) ? CREATE_NEW_PROCESS_GROUP : CREATE_NEW_CONSOLE); === modified file 'test/ChangeLog' --- test/ChangeLog 2014-10-20 19:59:41 +0000 +++ test/ChangeLog 2014-10-25 09:12:01 +0000 @@ -1,3 +1,8 @@ +2014-10-22 Noam Postavsky + + * test/automated/process-tests.el (process-test-quoted-batfile): + New test. + 2014-10-20 Glenn Morris * Merge in all changes up to 24.4 release. === modified file 'test/automated/process-tests.el' --- test/automated/process-tests.el 2014-01-01 07:43:34 +0000 +++ test/automated/process-tests.el 2014-10-25 09:12:01 +0000 @@ -50,4 +50,26 @@ (should (process-test-sentinel-wait-function-working-p (lambda () (sit-for 0.01 t))))) +(when (eq system-type 'windows-nt) + (ert-deftest process-test-quoted-batfile () + "Check that Emacs hides CreateProcess deficiency (bug#18745)." + (let (batfile) + (unwind-protect + (progn + ;; CreateProcess will fail when both the bat file and 1st + ;; argument are quoted, so include spaces in both of those + ;; to force quoting. + (setq batfile (make-temp-file "echo args" nil ".bat")) + (with-temp-file batfile + (insert "@echo arg1 = %1, arg2 = %2\n")) + (with-temp-buffer + (call-process batfile nil '(t t) t "x &y") + (should (string= (buffer-string) "arg1 = \"x &y\", arg2 = \n"))) + (with-temp-buffer + (call-process-shell-command + (mapconcat #'shell-quote-argument (list batfile "x &y") " ") + nil '(t t) t) + (should (string= (buffer-string) "arg1 = \"x &y\", arg2 = \n")))) + (when batfile (delete-file batfile)))))) + (provide 'process-tests) ------------------------------------------------------------ revno: 118195 committer: Vincent Bela?che branch nick: trunk timestamp: Sat 2014-10-25 01:02:25 +0200 message: * ses.el (macroexp): add require for this package, so that function `ses--cell gets macroexp-quote. (ses--cell): makes formula a macroexp-quote of value when formula is nil. The rationale of this changr is to allow in the future shorter SES files, e.g. we could have only `(ses-cell A1 1.0)' instead of `(ses-cell A1 1.0 1.0 nil REFLIST)'. In such a case reference list REFLIST would be re-computed after load --- thus trading off load time against file size. * emacs-lisp/package.el (package--alist-to-plist-args): use macroexp-quote instead of a lambda expression which has the same content as macroexp-quote. (macroexp): add require for this package, so that function `package--alist-to-plist-args' gets macroexp-quote. * emacs-lisp/macroexp.el (macroexp-quote): new defun. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-10-24 22:23:43 +0000 +++ lisp/ChangeLog 2014-10-24 23:02:25 +0000 @@ -1,3 +1,22 @@ +2014-10-24 Vincent Belaïche + + * ses.el (macroexp): add require for this package, so that function + `ses--cell gets macroexp-quote. + (ses--cell): makes formula a macroexp-quote of value when formula + is nil. The rationale of this changr is to allow in the future + shorter SES files, e.g. we could have only `(ses-cell A1 1.0)' + instead of `(ses-cell A1 1.0 1.0 nil REFLIST)'. In such a case + reference list REFLIST would be re-computed after load --- thus + trading off load time against file size. + + * emacs-lisp/package.el (package--alist-to-plist-args): use + macroexp-quote instead of a lambda expression which has the same + content as macroexp-quote. + (macroexp): add require for this package, so that function + `package--alist-to-plist-args' gets macroexp-quote. + + * emacs-lisp/macroexp.el (macroexp-quote): new defun. + 2014-10-24 Stefan Monnier * term/ns-win.el (ns-store-cut-buffer-internal) === modified file 'lisp/emacs-lisp/macroexp.el' --- lisp/emacs-lisp/macroexp.el 2014-04-22 07:04:34 +0000 +++ lisp/emacs-lisp/macroexp.el 2014-10-24 23:02:25 +0000 @@ -370,6 +370,18 @@ "Return non-nil if EXP can be copied without extra cost." (or (symbolp exp) (macroexp-const-p exp))) +(defun macroexp-quote (v) + "Returns an expression E such that `(eval E)' is V. + +E is either V or (quote V) depending on whether V evaluates to +itself or not." + (if (and (not (consp v)) + (or (keywordp v) + (not (symbolp v)) + (memq v '(nil t)))) + v + (list 'quote v))) + ;;; Load-time macro-expansion. ;; Because macro-expansion used to be more lazy, eager macro-expansion === modified file 'lisp/emacs-lisp/package.el' --- lisp/emacs-lisp/package.el 2014-10-23 21:38:56 +0000 +++ lisp/emacs-lisp/package.el 2014-10-24 23:02:25 +0000 @@ -165,6 +165,7 @@ (eval-when-compile (require 'epg)) ;For setf accessors. (require 'tabulated-list) +(require 'macroexp) (defgroup package nil "Manager for Emacs Lisp packages." @@ -723,12 +724,7 @@ nil pkg-file nil 'silent)))) (defun package--alist-to-plist-args (alist) - (mapcar (lambda (x) - (if (and (not (consp x)) - (or (keywordp x) - (not (symbolp x)) - (memq x '(nil t)))) - x `',x)) + (mapcar 'macroexp-quote (apply #'nconc (mapcar (lambda (pair) (list (car pair) (cdr pair))) alist)))) (defun package-unpack (pkg-desc) === modified file 'lisp/ses.el' --- lisp/ses.el 2014-10-01 17:23:42 +0000 +++ lisp/ses.el 2014-10-24 23:02:25 +0000 @@ -491,7 +491,8 @@ (let ((rowcol (ses-sym-rowcol sym))) (ses-formula-record formula) (ses-printer-record printer) - (unless formula (setq formula value)) + (unless (or formula (eq formula '*skip*)) + (setq formula (macroexp-quote value))) (or (atom formula) (eq safe-functions t) (setq formula `(ses-safe-formula ,formula))) ------------------------------------------------------------ revno: 118194 fixes bug: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=18816 committer: Stefan Monnier branch nick: trunk timestamp: Fri 2014-10-24 18:23:43 -0400 message: * lisp/term/ns-win.el (ns-store-cut-buffer-internal) (ns-copy-including-secondary): Use gui-set-selection. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-10-24 09:58:43 +0000 +++ lisp/ChangeLog 2014-10-24 22:23:43 +0000 @@ -1,3 +1,8 @@ +2014-10-24 Stefan Monnier + + * term/ns-win.el (ns-store-cut-buffer-internal) + (ns-copy-including-secondary): Use gui-set-selection (bug#18816). + 2014-10-24 Martin Rudalics * mouse.el (mouse-drag-line): Don't use mouse-pixel-position. === modified file 'lisp/term/ns-win.el' --- lisp/term/ns-win.el 2014-10-21 15:27:18 +0000 +++ lisp/term/ns-win.el 2014-10-24 22:23:43 +0000 @@ -718,19 +718,18 @@ ;;;; Pasteboard support. (declare-function ns-get-selection-internal "nsselect.m" (buffer)) -(declare-function ns-store-selection-internal "nsselect.m" (buffer string)) (define-obsolete-function-alias 'ns-get-cut-buffer-internal 'ns-get-selection-internal "24.1") (define-obsolete-function-alias 'ns-store-cut-buffer-internal - 'ns-store-selection-internal "24.1") + 'gui-set-selection "24.1") (defun ns-copy-including-secondary () (interactive) (call-interactively 'kill-ring-save) - (ns-store-selection-internal 'SECONDARY - (buffer-substring (point) (mark t)))) + (gui-set-selection 'SECONDARY (buffer-substring (point) (mark t)))) + (defun ns-paste-secondary () (interactive) (insert (ns-get-selection-internal 'SECONDARY))) ------------------------------------------------------------ revno: 118193 fixes bug: http://debbugs.gnu.org/18815 committer: Eli Zaretskii branch nick: trunk timestamp: Fri 2014-10-24 16:19:21 +0300 message: A possible fix for bug #18815 with assertion violations in bidi.c. src/bidi.c (bidi_resolve_explicit, bidi_find_bracket_pairs) (bidi_resolve_brackets): Use end of string position rather than ZV when iterating over a string. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2014-10-24 09:58:43 +0000 +++ src/ChangeLog 2014-10-24 13:19:21 +0000 @@ -1,3 +1,9 @@ +2014-10-24 Eli Zaretskii + + * bidi.c (bidi_resolve_explicit, bidi_find_bracket_pairs) + (bidi_resolve_brackets): Use end of string position rather than ZV + when iterating over a string. (Bug#18815) + 2014-10-24 Martin Rudalics * keyboard.c (make_lispy_position): Return coordinates also when === modified file 'src/bidi.c' --- src/bidi.c 2014-10-22 16:09:57 +0000 +++ src/bidi.c 2014-10-24 13:19:21 +0000 @@ -1743,6 +1743,9 @@ bool string_p = bidi_it->string.s || STRINGP (bidi_it->string.lstring); ptrdiff_t ch_len, nchars, disp_pos, end; int disp_prop; + ptrdiff_t eob + = ((bidi_it->string.s || STRINGP (bidi_it->string.lstring)) + ? bidi_it->string.schars : ZV); /* Record the info about the previous character. */ if (bidi_it->type_after_wn != WEAK_BN /* W1/Retaining */ @@ -1774,7 +1777,7 @@ /* If needed, reset the "magical" value of pairing bracket position, so that bidi_resolve_brackets will resume resolution of brackets according to BPA. */ - if (bidi_it->bracket_pairing_pos == ZV) + if (bidi_it->bracket_pairing_pos == eob) bidi_it->bracket_pairing_pos = -1; } if (bidi_it->next_en_pos >= 0 @@ -1787,7 +1790,7 @@ /* Reset the bracket resolution info, unless we previously decided (in bidi_find_bracket_pairs) that brackets in this level run should be resolved as neutrals. */ - if (bidi_it->bracket_pairing_pos != ZV) + if (bidi_it->bracket_pairing_pos != eob) { bidi_it->bracket_pairing_pos = -1; bidi_it->bracket_enclosed_type = UNKNOWN_BT; @@ -2608,6 +2611,10 @@ && ((base_level == 0 && !r2l_seen) || (base_level == 1 && !l2r_seen))) { + ptrdiff_t eob + = ((bidi_it->string.s || STRINGP (bidi_it->string.lstring)) + ? bidi_it->string.schars : ZV); + if (retval) pairing_pos = bidi_it->bracket_pairing_pos; @@ -2616,7 +2623,7 @@ will be noticed by bidi_resolve_explicit, and will be copied to the following iterator states, instead of being reset to -1. */ - bidi_it->bracket_pairing_pos = ZV; + bidi_it->bracket_pairing_pos = eob; /* This type value will be used for resolving the outermost closing bracket in bidi_resolve_brackets. */ bidi_it->bracket_enclosed_type = embedding_type; @@ -2669,6 +2676,9 @@ bidi_type_t type = UNKNOWN_BT; int ch; struct bidi_saved_info prev_for_neutral, next_for_neutral; + ptrdiff_t eob + = ((bidi_it->string.s || STRINGP (bidi_it->string.lstring)) + ? bidi_it->string.schars : ZV); /* Record the prev_for_neutral type either from the previous character, if it was a strong or AN/EN, or from the @@ -2693,11 +2703,11 @@ type = bidi_resolve_weak (bidi_it); if (type == NEUTRAL_ON) { - /* bracket_pairing_pos == ZV means this bracket does not + /* bracket_pairing_pos == eob means this bracket does not need to be resolved as a bracket, but as a neutral, see the optimization trick we play near the end of bidi_find_bracket_pairs. */ - if (bidi_it->bracket_pairing_pos == ZV) + if (bidi_it->bracket_pairing_pos == eob) { /* If this is the outermost closing bracket of a run of characters in which we decided to resolve brackets as @@ -2711,7 +2721,7 @@ resolve_bracket = true; } } - else if (bidi_it->bracket_pairing_pos != ZV) + else if (bidi_it->bracket_pairing_pos != eob) { eassert (bidi_it->resolved_level == -1); /* If the cached state shows an increase of embedding level due ------------------------------------------------------------ revno: 118192 committer: martin rudalics branch nick: trunk timestamp: Fri 2014-10-24 11:58:43 +0200 message: Improve mouse dragging of frame edges. * keyboard.c (make_lispy_position): Return coordinates also when on scroll bars, fringes, margins or not in a window. * xdisp.c (show_mouse_face): Don't change cursor face during mouse tracking. * mouse.el (mouse-drag-line): Don't use mouse-pixel-position. Calculate increment from last position instead of window edge. Add right- and bottom-divider bindings to transient map. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-10-23 21:44:36 +0000 +++ lisp/ChangeLog 2014-10-24 09:58:43 +0000 @@ -1,3 +1,9 @@ +2014-10-24 Martin Rudalics + + * mouse.el (mouse-drag-line): Don't use mouse-pixel-position. + Calculate increment from last position instead of window edge. + Add right- and bottom-divider bindings to transient map. + 2014-10-23 Stefan Monnier * emacs-lisp/cl-macs.el (cl-defstruct): Define an internal predicate === modified file 'lisp/mouse.el' --- lisp/mouse.el 2014-10-21 20:11:22 +0000 +++ lisp/mouse.el 2014-10-24 09:58:43 +0000 @@ -355,24 +355,6 @@ (split-window-horizontally (min (max new-width first-col) last-col)))))) -;; `mouse-drag-line' is now the common routine for handling all line -;; dragging events combining the earlier `mouse-drag-mode-line-1' and -;; `mouse-drag-vertical-line'. It should improve the behavior of line -;; dragging wrt Emacs 23 as follows: - -;; (1) Gratuitous error messages and restrictions have been (hopefully) -;; removed. (The help-echo that dragging the mode-line can resize a -;; one-window-frame's window will still show through via bindings.el.) - -;; (2) No gratuitous selection of other windows should happen. (This -;; has not been completely fixed for mouse-autoselected windows yet.) - -;; (3) Mouse clicks below a scroll-bar should pass through via unread -;; command events. - -;; Note that `window-in-direction' replaces `mouse-drag-window-above' -;; and `mouse-drag-vertical-line-rightward-window' with Emacs 24.1. - (defun mouse-drag-line (start-event line) "Drag a mode line, header line, or vertical line with the mouse. START-EVENT is the starting mouse-event of the drag action. LINE @@ -383,132 +365,136 @@ (start (event-start start-event)) (window (posn-window start)) (frame (window-frame window)) - (minibuffer-window (minibuffer-window frame)) - (side (and (eq line 'vertical) - (or (cdr (assq 'vertical-scroll-bars - (frame-parameters frame))) - 'right))) + ;; `position' records the x- or y-coordinate of the last + ;; sampled position. + (position (if (eq line 'vertical) + (+ (window-pixel-left window) + (car (posn-x-y start))) + (+ (window-pixel-top window) + (cdr (posn-x-y start))))) + ;; `last-position' records the x- or y-coordinate of the + ;; previously sampled position. The difference of `position' + ;; and `last-position' determines the size change of WINDOW. + (last-position position) (draggable t) - height growth dragged) + posn-window growth dragged) + ;; Decide on whether we are allowed to track at all and whose + ;; window's edge we drag. (cond ((eq line 'header) - ;; Check whether header-line can be dragged at all. (if (window-at-side-p window 'top) + ;; We can't drag the header line of a topmost window. (setq draggable nil) - ;; window-pixel-edges includes the header and mode lines, so - ;; we need to account for that when calculating window growth. - ;; On GUI frames, assume the mouse is approximately in the - ;; middle of the header/mode line, so we need only half the - ;; height in pixels. - (setq height - (cond - ((display-graphic-p frame) - (/ (window-header-line-height window) 2)) - (t (window-header-line-height window)))) + ;; Drag bottom edge of window above the header line. (setq window (window-in-direction 'above window t)))) ((eq line 'mode) - ;; Check whether mode-line can be dragged at all. (if (and (window-at-side-p window 'bottom) - ;; Allow resizing the minibuffer window if it's on the same - ;; frame as and immediately below the clicked window, and - ;; it's active or `resize-mini-windows' is nil. - (not (and (eq (window-frame minibuffer-window) frame) - (= (nth 1 (window-pixel-edges minibuffer-window)) - (nth 3 (window-pixel-edges window))) - (or (not resize-mini-windows) - (eq minibuffer-window - (active-minibuffer-window)))))) - (setq draggable nil) - (setq height - (cond - ((display-graphic-p frame) - (/ (window-mode-line-height window) 2)) - (t (window-mode-line-height window)))))) - ((eq line 'vertical) - ;; Get the window to adjust for the vertical case. If the scroll - ;; bar is on the window's right or we drag a vertical divider, - ;; adjust the window where the start-event occurred. If the - ;; scroll bar is on the start-event window's left or there are no - ;; scrollbars, adjust the window on the left of it. - (unless (or (eq side 'right) - (not (zerop (window-right-divider-width window)))) - (setq window (window-in-direction 'left window t))))) + ;; Allow resizing the minibuffer window if it's on the + ;; same frame as and immediately below `window', and it's + ;; either active or `resize-mini-windows' is nil. + (let ((minibuffer-window (minibuffer-window frame))) + (not (and (eq (window-frame minibuffer-window) frame) + (or (not resize-mini-windows) + (eq minibuffer-window + (active-minibuffer-window))))))) + (setq draggable nil)))) (let* ((exitfun nil) (move - (lambda (event) (interactive "e") - (let ((position - ;; For graphic terminals, we're better off using - ;; mouse-pixel-position for the following reasons: - ;; - when the mouse has moved outside of the frame, `event' - ;; does not contain any useful pixel position any more. - ;; - mouse-pixel-position is a bit more uptodate (the mouse - ;; may have moved still a bit further since the event was - ;; generated). - (if (display-mouse-p) - (mouse-pixel-position) - (let* ((posn (event-end event)) - (pos (posn-x-y posn)) - (w (posn-window posn)) - (pe (if (windowp w) (window-pixel-edges w)))) - (cons (if (windowp w) (window-frame w) w) - (if pe - (cons (+ (car pos) (nth 0 pe)) - (+ (cdr pos) (nth 1 pe))))))))) - (cond - ((not (and (eq (car position) frame) - (cadr position))) - nil) - ((eq line 'vertical) - ;; Drag vertical divider. This must be probably fixed like - ;; for the mode-line. - (setq growth (- (cadr position) - (if (eq side 'right) 0 2) - (nth 2 (window-pixel-edges window)) - -1)) - (unless (zerop growth) - (setq dragged t) - (adjust-window-trailing-edge window growth t t))) - (draggable - ;; Drag horizontal divider. - (setq growth - (if (eq line 'mode) - (- (+ (cddr position) height) - (nth 3 (window-pixel-edges window))) - ;; The window's top includes the header line! - (- (+ (nth 3 (window-pixel-edges window)) height) - (cddr position)))) - (unless (zerop growth) - (setq dragged t) - (adjust-window-trailing-edge - window (if (eq line 'mode) growth (- growth)) nil t)))))))) - - ;; Start tracking. - (setq track-mouse t) - ;; Loop reading events and sampling the position of the mouse. - (setq exitfun - (set-transient-map - (let ((map (make-sparse-keymap))) - (define-key map [switch-frame] #'ignore) - (define-key map [select-window] #'ignore) - (define-key map [mouse-movement] move) - (define-key map [scroll-bar-movement] move) - ;; Swallow drag-mouse-1 events to avoid selecting some other window. - (define-key map [drag-mouse-1] - (lambda () (interactive) (funcall exitfun))) - ;; For vertical line dragging swallow also a mouse-1 - ;; event (but only if we dragged at least once to allow mouse-1 - ;; clicks to get through). - (when (eq line 'vertical) - (define-key map [mouse-1] - `(menu-item "" ,(lambda () (interactive) (funcall exitfun)) - :filter ,(lambda (cmd) (if dragged cmd))))) - ;; Some of the events will of course end up looked up - ;; with a mode-line or header-line prefix. - (define-key map [mode-line] map) - (define-key map [header-line] map) - map) - t (lambda () (setq track-mouse nil))))))) + (lambda (event) (interactive "e") + (cond + ((not (consp event)) + nil) + ((eq line 'vertical) + ;; Drag right edge of `window'. + (setq start (event-start event)) + (setq position (car (posn-x-y start))) + ;; Set `posn-window' to the window where `event' was recorded. + ;; This can be `window' or the window on the left or right of + ;; `window'. + (when (window-live-p (setq posn-window (posn-window start))) + ;; Add left edge of `posn-window' to `position'. + (setq position (+ (window-pixel-left posn-window) position)) + (unless (nth 1 start) + ;; Add width of objects on the left of the text area to + ;; `position'. + (when (eq (window-current-scroll-bars posn-window) 'left) + (setq position (+ (window-scroll-bar-width posn-window) + position))) + (setq position (+ (car (window-fringes posn-window)) + (or (car (window-margins posn-window)) 0) + position)))) + ;; When the cursor overshoots after shrinking a window to its + ;; minimum size and the dragging direction changes, have the + ;; cursor first catch up with the window edge. + (unless (or (zerop (setq growth (- position last-position))) + (and (> growth 0) + (< position (+ (window-pixel-left window) + (window-pixel-width window)))) + (and (< growth 0) + (> position (+ (window-pixel-left window) + (window-pixel-width window))))) + (setq dragged t) + (adjust-window-trailing-edge window growth t t)) + (setq last-position position)) + (draggable + ;; Drag bottom edge of `window'. + (setq start (event-start event)) + ;; Set `posn-window' to the window where `event' was recorded. + ;; This can be either `window' or the window above or below of + ;; `window'. + (setq posn-window (posn-window start)) + (setq position (cdr (posn-x-y start))) + (when (window-live-p posn-window) + ;; Add top edge of `posn-window' to `position'. + (setq position (+ (window-pixel-top posn-window) position)) + ;; If necessary, add height of header line to `position' + (when (memq (posn-area start) + '(nil left-fringe right-frings left-margin right-margin)) + (setq position (+ (window-header-line-height posn-window) position)))) + ;; When the cursor overshoots after shrinking a window to its + ;; minimum size and the dragging direction changes, have the + ;; cursor first catch up with the window edge. + (unless (or (zerop (setq growth (- position last-position))) + (and (> growth 0) + (< position (+ (window-pixel-top window) + (window-pixel-height window)))) + (and (< growth 0) + (> position (+ (window-pixel-top window) + (window-pixel-height window))))) + (setq dragged t) + (adjust-window-trailing-edge window growth nil t)) + (setq last-position position)))))) + ;; Start tracking. + (setq track-mouse t) + ;; Loop reading events and sampling the position of the mouse. + (setq exitfun + (set-transient-map + (let ((map (make-sparse-keymap))) + (define-key map [switch-frame] #'ignore) + (define-key map [select-window] #'ignore) + (define-key map [scroll-bar-movement] #'ignore) + (define-key map [mouse-movement] move) + ;; Swallow drag-mouse-1 events to avoid selecting some other window. + (define-key map [drag-mouse-1] + (lambda () (interactive) (funcall exitfun))) + ;; For vertical line dragging swallow also a mouse-1 + ;; event (but only if we dragged at least once to allow mouse-1 + ;; clicks to get through). + (when (eq line 'vertical) + (define-key map [mouse-1] + `(menu-item "" ,(lambda () (interactive) (funcall exitfun)) + :filter ,(lambda (cmd) (if dragged cmd))))) + ;; Some of the events will of course end up looked up + ;; with a mode-line or header-line prefix ... + (define-key map [mode-line] map) + (define-key map [header-line] map) + ;; ... and some maybe even with a right- or bottom-divider + ;; prefix. + (define-key map [right-divider] map) + (define-key map [bottom-divider] map) + map) + t (lambda () (setq track-mouse nil))))))) (defun mouse-drag-mode-line (start-event) "Change the height of a window by dragging on the mode line." === modified file 'src/ChangeLog' --- src/ChangeLog 2014-10-23 13:21:07 +0000 +++ src/ChangeLog 2014-10-24 09:58:43 +0000 @@ -1,3 +1,10 @@ +2014-10-24 Martin Rudalics + + * keyboard.c (make_lispy_position): Return coordinates also when + on scroll bars, fringes, margins or not in a window. + * xdisp.c (show_mouse_face): Don't change cursor face during + mouse tracking. + 2014-10-23 Martin Rudalics * frame.c (Fset_frame_height, Fset_frame_width, Fset_frame_size) === modified file 'src/keyboard.c' --- src/keyboard.c 2014-10-14 12:45:41 +0000 +++ src/keyboard.c 2014-10-24 09:58:43 +0000 @@ -5332,12 +5332,14 @@ &object, &dx, &dy, &width, &height); if (STRINGP (string)) string_info = Fcons (string, make_number (charpos)); + xret = wx; yret = wy - WINDOW_HEADER_LINE_HEIGHT (w); } else if (part == ON_LEFT_FRINGE) { posn = Qleft_fringe; col = 0; + xret = wx; dx = wx - (WINDOW_HAS_FRINGES_OUTSIDE_MARGINS (w) ? 0 : window_box_width (w, LEFT_MARGIN_AREA)); @@ -5347,6 +5349,7 @@ { posn = Qright_fringe; col = 0; + xret = wx; dx = wx - window_box_width (w, LEFT_MARGIN_AREA) - window_box_width (w, TEXT_AREA) @@ -5360,9 +5363,23 @@ posn = Qvertical_line; width = 1; dx = 0; - dy = yret = wy; - } - /* Nothing special for part == ON_SCROLL_BAR. */ + xret = wx; + dy = yret = wy; + } + else if (part == ON_VERTICAL_SCROLL_BAR) + { + posn = Qvertical_scroll_bar; + width = WINDOW_SCROLL_BAR_AREA_WIDTH (w); + dx = xret = wx; + dy = yret = wy; + } + else if (part == ON_HORIZONTAL_SCROLL_BAR) + { + posn = Qhorizontal_scroll_bar; + width = WINDOW_SCROLL_BAR_AREA_HEIGHT (w); + dx = xret = wx; + dy = yret = wy; + } else if (part == ON_RIGHT_DIVIDER) { posn = Qright_divider; @@ -5446,7 +5463,12 @@ extra_info))); } else if (f != 0) - XSETFRAME (window, f); + { + /* Return mouse pixel coordinates here. */ + XSETFRAME (window, f); + xret = XINT (x); + yret = XINT (y); + } else window = Qnil; === modified file 'src/xdisp.c' --- src/xdisp.c 2014-10-21 01:17:06 +0000 +++ src/xdisp.c 2014-10-24 09:58:43 +0000 @@ -27961,7 +27961,7 @@ #ifdef HAVE_WINDOW_SYSTEM /* Change the mouse cursor. */ - if (FRAME_WINDOW_P (f)) + if (FRAME_WINDOW_P (f) && NILP (do_mouse_tracking)) { #if ! defined (USE_GTK) && ! defined (HAVE_NS) if (draw == DRAW_NORMAL_TEXT ------------------------------------------------------------ revno: 118191 committer: Katsumi Yamaoka branch nick: trunk timestamp: Fri 2014-10-24 09:29:09 +0000 message: lisp/gnus/ChangeLog (2014-10-24): Add bug# diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2014-10-24 08:34:32 +0000 +++ lisp/gnus/ChangeLog 2014-10-24 09:29:09 +0000 @@ -6,7 +6,7 @@ 2014-10-24 enami tsugutomo * nnimap.el (nnimap-wait-for-response): Ignore NOOP response requested - to keep connection open. + to keep connection open (bug#18728). 2014-10-20 Glenn Morris ------------------------------------------------------------ revno: 118190 committer: Katsumi Yamaoka branch nick: trunk timestamp: Fri 2014-10-24 08:34:32 +0000 message: lisp/gnus/gnus.el (gnus-mode-line-buffer-identification): Don't shadow load-path, it blocks autoloading of find-image (bug#18813) diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2014-10-24 06:05:57 +0000 +++ lisp/gnus/ChangeLog 2014-10-24 08:34:32 +0000 @@ -1,3 +1,8 @@ +2014-10-24 Katsumi Yamaoka + + * gnus.el (gnus-mode-line-buffer-identification): Don't shadow + load-path, it blocks autoloading of find-image (bug#18813). + 2014-10-24 enami tsugutomo * nnimap.el (nnimap-wait-for-response): Ignore NOOP response requested === modified file 'lisp/gnus/gnus.el' --- lisp/gnus/gnus.el 2014-03-23 23:13:36 +0000 +++ lisp/gnus/gnus.el 2014-10-24 08:34:32 +0000 @@ -326,7 +326,7 @@ (if (fboundp 'find-image) (defun gnus-mode-line-buffer-identification (line) (let ((str (car-safe line)) - (load-path (mm-image-load-path))) + (load-path (append (mm-image-load-path) load-path))) (if (and (stringp str) (string-match "^Gnus:" str)) (progn (add-text-properties ------------------------------------------------------------ revno: 118189 author: enami tsugutomo committer: Katsumi Yamaoka branch nick: trunk timestamp: Fri 2014-10-24 06:05:57 +0000 message: lisp/gnus/nnimap.el (nnimap-wait-for-response): Ignore NOOP response requested to keep connection open diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2014-10-23 01:38:59 +0000 +++ lisp/gnus/ChangeLog 2014-10-24 06:05:57 +0000 @@ -1,3 +1,8 @@ +2014-10-24 enami tsugutomo + + * nnimap.el (nnimap-wait-for-response): Ignore NOOP response requested + to keep connection open. + 2014-10-20 Glenn Morris * Merge in all changes up to 24.4 release. === modified file 'lisp/gnus/nnimap.el' --- lisp/gnus/nnimap.el 2014-10-04 23:57:35 +0000 +++ lisp/gnus/nnimap.el 2014-10-24 06:05:57 +0000 @@ -1888,7 +1888,7 @@ (while (and (not (bobp)) (progn (forward-line -1) - (looking-at "\\*")))) + (looking-at "\\*\\|[0-9]+ OK NOOP")))) (not (looking-at (format "%d .*\n" sequence))))) (when messagep (nnheader-message-maybe ------------------------------------------------------------ revno: 118188 committer: Stefan Monnier branch nick: trunk timestamp: Fri 2014-10-24 00:09:55 -0400 message: * lisp/cedet/semantic/complete.el: Require semantic/db-find. diff: === modified file 'lisp/cedet/ChangeLog' --- lisp/cedet/ChangeLog 2014-10-21 01:17:06 +0000 +++ lisp/cedet/ChangeLog 2014-10-24 04:09:55 +0000 @@ -1,3 +1,7 @@ +2014-10-24 Stefan Monnier + + * semantic/complete.el: Require semantic/db-find. + 2014-10-20 Glenn Morris * Merge in all changes up to 24.4 release. === modified file 'lisp/cedet/semantic/complete.el' --- lisp/cedet/semantic/complete.el 2014-01-13 20:04:08 +0000 +++ lisp/cedet/semantic/complete.el 2014-10-24 04:09:55 +0000 @@ -118,6 +118,7 @@ (eval-when-compile ;; For the semantic-find-tags-for-completion macro. (require 'semantic/find)) +(require 'semantic/db-find) ;For type semanticdb-find-result-with-nil. ;;; Code: ------------------------------------------------------------ revno: 118187 committer: Stefan Monnier branch nick: trunk timestamp: Thu 2014-10-23 17:44:36 -0400 message: * lisp/emacs-lisp/cl-macs.el (cl-defstruct): Define an internal predicate even if :predicate was nil, for the benefit of typep. Record the name of the predicate for typep's use. (cl--make-type-test): Use pcase. Obey new cl-deftype-satisfies property. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-10-23 21:38:56 +0000 +++ lisp/ChangeLog 2014-10-23 21:44:36 +0000 @@ -1,5 +1,11 @@ 2014-10-23 Stefan Monnier + * emacs-lisp/cl-macs.el (cl-defstruct): Define an internal predicate + even if :predicate was nil, for the benefit of typep. + Record the name of the predicate for typep's use. + (cl--make-type-test): Use pcase. Obey new + cl-deftype-satisfies property. + * epg.el: Use cl-defstruct. (epg-make-data-from-file, epg-make-data-from-string, epg-data-file) (epg-data-string): Define via cl-defstruct. === modified file 'lisp/emacs-lisp/cl-macs.el' --- lisp/emacs-lisp/cl-macs.el 2014-10-17 05:09:24 +0000 +++ lisp/emacs-lisp/cl-macs.el 2014-10-23 21:44:36 +0000 @@ -2487,6 +2487,8 @@ (setq type 'vector named 'true))) (or named (setq descs (delq (assq 'cl-tag-slot descs) descs))) (push `(defvar ,tag-symbol) forms) + (when (and (null predicate) named) + (setq predicate (intern (format "cl--struct-%s-p" name)))) (setq pred-form (and named (let ((pos (- (length descs) (length (memq (assq 'cl-tag-slot descs) @@ -2502,7 +2504,8 @@ pred-check (and pred-form (> safety 0) (if (and (eq (cl-caadr pred-form) 'vectorp) (= safety 1)) - (cons 'and (cl-cdddr pred-form)) pred-form))) + (cons 'and (cl-cdddr pred-form)) + `(,predicate cl-x)))) (let ((pos 0) (descp descs)) (while descp (let* ((desc (pop descp)) @@ -2557,13 +2560,14 @@ (setq pos (1+ pos)))) (setq slots (nreverse slots) defaults (nreverse defaults)) - (and predicate pred-form - (progn (push `(cl-defsubst ,predicate (cl-x) - ,(if (eq (car pred-form) 'and) - (append pred-form '(t)) - `(and ,pred-form t))) - forms) - (push (cons predicate 'error-free) side-eff))) + (when pred-form + (push `(cl-defsubst ,predicate (cl-x) + ,(if (eq (car pred-form) 'and) + (append pred-form '(t)) + `(and ,pred-form t))) + forms) + (push `(put ',name 'cl-deftype-satisfies ',predicate) forms) + (push (cons predicate 'error-free) side-eff)) (and copier (progn (push `(defun ,copier (x) (copy-sequence x)) forms) (push (cons copier t) side-eff))) @@ -2647,46 +2651,48 @@ (cdr (assq sym byte-compile-macro-environment)))))) (defun cl--make-type-test (val type) - (if (symbolp type) - (cond ((get type 'cl-deftype-handler) - (cl--make-type-test val (funcall (get type 'cl-deftype-handler)))) - ((memq type '(nil t)) type) - ((eq type 'null) `(null ,val)) - ((eq type 'atom) `(atom ,val)) - ((eq type 'float) `(floatp ,val)) - ((eq type 'real) `(numberp ,val)) - ((eq type 'fixnum) `(integerp ,val)) - ;; FIXME: Should `character' accept things like ?\C-\M-a ? --Stef - ((memq type '(character string-char)) `(characterp ,val)) - (t - (let* ((name (symbol-name type)) - (namep (intern (concat name "p")))) - (cond - ((cl--macroexp-fboundp namep) (list namep val)) - ((cl--macroexp-fboundp - (setq namep (intern (concat name "-p")))) - (list namep val)) - (t (list type val)))))) - (cond ((get (car type) 'cl-deftype-handler) - (cl--make-type-test val (apply (get (car type) 'cl-deftype-handler) - (cdr type)))) - ((memq (car type) '(integer float real number)) - (delq t `(and ,(cl--make-type-test val (car type)) - ,(if (memq (cadr type) '(* nil)) t - (if (consp (cadr type)) `(> ,val ,(cl-caadr type)) - `(>= ,val ,(cadr type)))) - ,(if (memq (cl-caddr type) '(* nil)) t - (if (consp (cl-caddr type)) - `(< ,val ,(cl-caaddr type)) - `(<= ,val ,(cl-caddr type))))))) - ((memq (car type) '(and or not)) - (cons (car type) - (mapcar (function (lambda (x) (cl--make-type-test val x))) - (cdr type)))) - ((memq (car type) '(member cl-member)) - `(and (cl-member ,val ',(cdr type)) t)) - ((eq (car type) 'satisfies) `(funcall #',(cadr type) ,val)) - (t (error "Bad type spec: %s" type))))) + (pcase type + ((and `(,name . ,args) (guard (get name 'cl-deftype-handler))) + (cl--make-type-test val (apply (get name 'cl-deftype-handler) + args))) + (`(,(and name (or 'integer 'float 'real 'number)) + . ,(or `(,min ,max) pcase--dontcare)) + `(and ,(cl--make-type-test val name) + ,(if (memq min '(* nil)) t + (if (consp min) `(> ,val ,(car min)) + `(>= ,val ,min))) + ,(if (memq max '(* nil)) t + (if (consp max) + `(< ,val ,(car max)) + `(<= ,val ,max))))) + (`(,(and name (or 'and 'or 'not)) . ,args) + (cons name (mapcar (lambda (x) (cl--make-type-test val x)) args))) + (`(member . ,args) + `(and (cl-member ,val ',args) t)) + (`(satisfies ,pred) `(funcall #',pred ,val)) + ((and (pred symbolp) (guard (get type 'cl-deftype-handler))) + (cl--make-type-test val (funcall (get type 'cl-deftype-handler)))) + ((and (pred symbolp) (guard (get type 'cl-deftype-satisfies))) + `(funcall #',(get type 'cl-deftype-satisfies) ,val)) + ((or 'nil 't) type) + ('null `(null ,val)) + ('atom `(atom ,val)) + ('float `(floatp ,val)) + ('real `(numberp ,val)) + ('fixnum `(integerp ,val)) + ;; FIXME: Implement `base-char' and `extended-char'. + ('character `(characterp ,val)) + ((pred symbolp) + (let* ((name (symbol-name type)) + (namep (intern (concat name "p")))) + (cond + ((cl--macroexp-fboundp namep) (list namep val)) + ((cl--macroexp-fboundp + (setq namep (intern (concat name "-p")))) + (list namep val)) + ((cl--macroexp-fboundp type) (list type val)) + (t (error "Unknown type %S" type))))) + (_ (error "Bad type spec: %s" type)))) (defvar cl--object) ;;;###autoload ------------------------------------------------------------ revno: 118186 committer: Stefan Monnier branch nick: trunk timestamp: Thu 2014-10-23 17:38:56 -0400 message: * lisp/epg.el: Use cl-defstruct. (epg-make-data-from-file, epg-make-data-from-string, epg-data-file) (epg-data-string): Define via cl-defstruct. (epg--gv-nreverse): New macro. (epg-context--make): New constructor (provided vi cl-defstruct). (epg-make-context): Rewrite using it. (epg-context-protocol, epg-context-program) (epg-context-home-directory, epg-context-armor, epg-context-textmode) (epg-context-include-certs, epg-context-cipher-algorithm) (epg-context-digest-algorithm, epg-context-compress-algorithm) (epg-context-passphrase-callback, epg-context-progress-callback) (epg-context-signers, epg-context-sig-notations, epg-context-process) (epg-context-output-file, epg-context-result, epg-context-operation) (epg-context-pinentry-mode): Define using cl-defstruct. (epg-context-set-protocol, epg-context-set-program) (epg-context-set-include-certs, epg-context-set-cipher-algorithm) (epg-context-set-digest-algorithm) (epg-context-set-sig-notations, epg-context-set-process) (epg-context-set-output-file, epg-context-set-result) (epg-context-set-operation, epg-context-set-pinentry-mode) (epg-context-set-compress-algorithm): Remove. Use setf instead. (epg-context-set-armor, epg-context-set-textmode) (epg-context-set-signers): Redefine using setf and declare as obsolete. (epg-context-set-passphrase-callback) (epg-context-set-progress-callback): Use setf. (epg-signature-notations): Rename from epg-sig-notations. (epg-make-signature, epg-signature-status, epg-signature-key-id) (epg-signature-validity, epg-signature-fingerprint) (epg-signature-creation-time, epg-signature-expiration-time) (epg-signature-pubkey-algorithm, epg-signature-digest-algorithm) (epg-signature-class, epg-signature-version): Define vi cl-defstruct. (epg-signature-set-status, epg-signature-set-key-id) (epg-signature-set-validity, epg-signature-set-fingerprint) (epg-signature-set-creation-time, epg-signature-set-expiration-time) (epg-signature-set-pubkey-algorithm) (epg-signature-set-digest-algorithm, epg-signature-set-class) (epg-signature-set-version, epg-signature-set-notations): Remove. Use setf instead. (epg-make-new-signature, epg-new-signature-type) (epg-new-signature-pubkey-algorithm) (epg-new-signature-digest-algorithm, epg-new-signature-class) (epg-new-signature-creation-time, epg-new-signature-fingerprint): Define using cl-defstruct. (epg-make-key, epg-key-owner-trust, epg-key-sub-key-list) (epg-key-user-id-list): Define using cl-defstruct. (epg-key-set-sub-key-list, epg-key-set-user-id-list): Remove. Use setf instead. (epg-make-sub-key, epg-sub-key-validity, epg-sub-key-capability) (epg-sub-key-secret-p, epg-sub-key-algorithm, epg-sub-key-length) (epg-sub-key-id, epg-sub-key-creation-time) (epg-sub-key-expiration-time, epg-sub-key-fingerprint): Define using cl-defstruct. (epg-sub-key-set-fingerprint): Remove. Use setf instead. (epg-make-user-id, epg-user-id-validity, epg-user-id-string) (epg-user-id-signature-list): Define using cl-defstruct. (epg-user-id-set-signature-list): Remove. Use setf instead. (epg-make-key-signature, epg-key-signature-validity) (epg-key-signature-pubkey-algorithm, epg-key-signature-key-id) (epg-key-signature-creation-time, epg-key-signature-expiration-time) (epg-key-signature-user-id, epg-key-signature-class) (epg-key-signature-exportable-p): Define using cl-defstruct. (epg-make-sig-notation, epg-sig-notation-name) (epg-sig-notation-value, epg-sig-notation-human-readable) (epg-sig-notation-critical): Define using cl-defstruct. (epg-sig-notation-set-value): Remove. Use setf instead. (epg-make-import-status, epg-import-status-fingerprint) (epg-import-status-reason, epg-import-status-new) (epg-import-status-user-id, epg-import-status-signature) (epg-import-status-sub-key, epg-import-status-secret): Define using cl-defstruct. (epg-make-import-result, epg-import-result-considered) (epg-import-result-no-user-id, epg-import-result-imported) (epg-import-result-imported-rsa, epg-import-result-unchanged) (epg-import-result-new-user-ids, epg-import-result-new-sub-keys) (epg-import-result-new-signatures, epg-import-result-new-revocations) (epg-import-result-secret-read, epg-import-result-secret-imported) (epg-import-result-secret-unchanged, epg-import-result-not-imported) (epg-import-result-imports): Define using cl-defstruct. * lisp/emacs-lisp/package.el: Require EPG during macroexpansion. (package--check-signature, package-import-keyring): Use setf instead of epg-context-set-home-directory. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-10-23 13:33:25 +0000 +++ lisp/ChangeLog 2014-10-23 21:38:56 +0000 @@ -1,5 +1,91 @@ 2014-10-23 Stefan Monnier + * epg.el: Use cl-defstruct. + (epg-make-data-from-file, epg-make-data-from-string, epg-data-file) + (epg-data-string): Define via cl-defstruct. + (epg--gv-nreverse): New macro. + (epg-context--make): New constructor (provided vi cl-defstruct). + (epg-make-context): Rewrite using it. + (epg-context-protocol, epg-context-program) + (epg-context-home-directory, epg-context-armor, epg-context-textmode) + (epg-context-include-certs, epg-context-cipher-algorithm) + (epg-context-digest-algorithm, epg-context-compress-algorithm) + (epg-context-passphrase-callback, epg-context-progress-callback) + (epg-context-signers, epg-context-sig-notations, epg-context-process) + (epg-context-output-file, epg-context-result, epg-context-operation) + (epg-context-pinentry-mode): Define using cl-defstruct. + (epg-context-set-protocol, epg-context-set-program) + (epg-context-set-include-certs, epg-context-set-cipher-algorithm) + (epg-context-set-digest-algorithm) + (epg-context-set-sig-notations, epg-context-set-process) + (epg-context-set-output-file, epg-context-set-result) + (epg-context-set-operation, epg-context-set-pinentry-mode) + (epg-context-set-compress-algorithm): Remove. Use setf instead. + (epg-context-set-armor, epg-context-set-textmode) + (epg-context-set-signers): Redefine using setf + and declare as obsolete. + (epg-context-set-passphrase-callback) + (epg-context-set-progress-callback): Use setf. + (epg-signature-notations): Rename from epg-sig-notations. + (epg-make-signature, epg-signature-status, epg-signature-key-id) + (epg-signature-validity, epg-signature-fingerprint) + (epg-signature-creation-time, epg-signature-expiration-time) + (epg-signature-pubkey-algorithm, epg-signature-digest-algorithm) + (epg-signature-class, epg-signature-version): Define vi cl-defstruct. + (epg-signature-set-status, epg-signature-set-key-id) + (epg-signature-set-validity, epg-signature-set-fingerprint) + (epg-signature-set-creation-time, epg-signature-set-expiration-time) + (epg-signature-set-pubkey-algorithm) + (epg-signature-set-digest-algorithm, epg-signature-set-class) + (epg-signature-set-version, epg-signature-set-notations): Remove. + Use setf instead. + (epg-make-new-signature, epg-new-signature-type) + (epg-new-signature-pubkey-algorithm) + (epg-new-signature-digest-algorithm, epg-new-signature-class) + (epg-new-signature-creation-time, epg-new-signature-fingerprint): + Define using cl-defstruct. + (epg-make-key, epg-key-owner-trust, epg-key-sub-key-list) + (epg-key-user-id-list): Define using cl-defstruct. + (epg-key-set-sub-key-list, epg-key-set-user-id-list): Remove. + Use setf instead. + (epg-make-sub-key, epg-sub-key-validity, epg-sub-key-capability) + (epg-sub-key-secret-p, epg-sub-key-algorithm, epg-sub-key-length) + (epg-sub-key-id, epg-sub-key-creation-time) + (epg-sub-key-expiration-time, epg-sub-key-fingerprint): Define using + cl-defstruct. + (epg-sub-key-set-fingerprint): Remove. Use setf instead. + (epg-make-user-id, epg-user-id-validity, epg-user-id-string) + (epg-user-id-signature-list): Define using cl-defstruct. + (epg-user-id-set-signature-list): Remove. Use setf instead. + (epg-make-key-signature, epg-key-signature-validity) + (epg-key-signature-pubkey-algorithm, epg-key-signature-key-id) + (epg-key-signature-creation-time, epg-key-signature-expiration-time) + (epg-key-signature-user-id, epg-key-signature-class) + (epg-key-signature-exportable-p): Define using cl-defstruct. + (epg-make-sig-notation, epg-sig-notation-name) + (epg-sig-notation-value, epg-sig-notation-human-readable) + (epg-sig-notation-critical): Define using cl-defstruct. + (epg-sig-notation-set-value): Remove. Use setf instead. + (epg-make-import-status, epg-import-status-fingerprint) + (epg-import-status-reason, epg-import-status-new) + (epg-import-status-user-id, epg-import-status-signature) + (epg-import-status-sub-key, epg-import-status-secret): Define using + cl-defstruct. + (epg-make-import-result, epg-import-result-considered) + (epg-import-result-no-user-id, epg-import-result-imported) + (epg-import-result-imported-rsa, epg-import-result-unchanged) + (epg-import-result-new-user-ids, epg-import-result-new-sub-keys) + (epg-import-result-new-signatures, epg-import-result-new-revocations) + (epg-import-result-secret-read, epg-import-result-secret-imported) + (epg-import-result-secret-unchanged, epg-import-result-not-imported) + (epg-import-result-imports): Define using cl-defstruct. + + * emacs-lisp/package.el: Require EPG during macroexpansion. + (package--check-signature, package-import-keyring): Use setf instead of + epg-context-set-home-directory. + +2014-10-23 Stefan Monnier + * emacs-lisp/bytecomp.el (byte-compile--use-old-handlers): Change default. 2014-10-23 Leo Liu === modified file 'lisp/emacs-lisp/package.el' --- lisp/emacs-lisp/package.el 2014-10-02 15:13:05 +0000 +++ lisp/emacs-lisp/package.el 2014-10-23 21:38:56 +0000 @@ -162,6 +162,7 @@ ;;; Code: (eval-when-compile (require 'cl-lib)) +(eval-when-compile (require 'epg)) ;For setf accessors. (require 'tabulated-list) @@ -809,7 +810,6 @@ cipher-algorithm digest-algorithm compress-algorithm)) -(declare-function epg-context-set-home-directory "epg" (context directory)) (declare-function epg-verify-string "epg" (context signature &optional signed-text)) (declare-function epg-context-result-for "epg" (context name)) @@ -824,7 +824,7 @@ (sig-file (concat file ".sig")) (sig-content (package--with-work-buffer location sig-file (buffer-string)))) - (epg-context-set-home-directory context homedir) + (setf (epg-context-home-directory context) homedir) (epg-verify-string context sig-content (buffer-string)) (let (good-signatures had-fatal-error) ;; The .sig file may contain multiple signatures. Success if one @@ -1303,7 +1303,7 @@ (homedir (expand-file-name "gnupg" package-user-dir))) (with-file-modes 448 (make-directory homedir t)) - (epg-context-set-home-directory context homedir) + (setf (epg-context-home-directory context) homedir) (message "Importing %s..." (file-name-nondirectory file)) (epg-import-keys-from-file context file) (message "Importing %s...done" (file-name-nondirectory file)))) === modified file 'lisp/epg.el' --- lisp/epg.el 2014-05-14 17:15:15 +0000 +++ lisp/epg.el 2014-10-23 21:38:56 +0000 @@ -23,6 +23,7 @@ ;;; Code: (require 'epg-config) +(eval-when-compile (require 'cl-lib)) (defvar epg-user-id nil "GnuPG ID of your default identity.") @@ -164,210 +165,73 @@ (define-error 'epg-error "GPG error") -(defun epg-make-data-from-file (file) - "Make a data object from FILE." - (cons 'epg-data (vector file nil))) - -(defun epg-make-data-from-string (string) - "Make a data object from STRING." - (cons 'epg-data (vector nil string))) - -(defun epg-data-file (data) - "Return the file of DATA." - (unless (eq (car-safe data) 'epg-data) - (signal 'wrong-type-argument (list 'epg-data-p data))) - (aref (cdr data) 0)) - -(defun epg-data-string (data) - "Return the string of DATA." - (unless (eq (car-safe data) 'epg-data) - (signal 'wrong-type-argument (list 'epg-data-p data))) - (aref (cdr data) 1)) - +(cl-defstruct (epg-data + (:constructor nil) + (:constructor epg-make-data-from-file (file)) + (:constructor epg-make-data-from-string (string)) + (:copier nil) + (:predicate nil)) + (file nil :read-only t) + (string nil :read-only t)) + +(defmacro epg--gv-nreverse (place) + (gv-letplace (getter setter) place + (funcall setter `(nreverse ,getter)))) + +(cl-defstruct (epg-context + (:constructor nil) + (:constructor epg-context--make + (protocol &optional armor textmode include-certs + cipher-algorithm digest-algorithm + compress-algorithm + &aux + (program + (pcase protocol + (`OpenPGP epg-gpg-program) + (`CMS epg-gpgsm-program) + (_ (signal 'epg-error + (list "unknown protocol" protocol))))))) + (:copier nil) + (:predicate nil)) + protocol + program + (home-directory epg-gpg-home-directory) + armor + textmode + include-certs + cipher-algorithm + digest-algorithm + compress-algorithm + (passphrase-callback (list #'epg-passphrase-callback-function)) + progress-callback + signers + sig-notations + process + output-file + result + operation + pinentry-mode) + +;; This is not an alias, just so we can mark it as autoloaded. ;;;###autoload (defun epg-make-context (&optional protocol armor textmode include-certs cipher-algorithm digest-algorithm compress-algorithm) "Return a context object." - (unless protocol - (setq protocol 'OpenPGP)) - (unless (memq protocol '(OpenPGP CMS)) - (signal 'epg-error (list "unknown protocol" protocol))) - (cons 'epg-context - (vector protocol - (if (eq protocol 'OpenPGP) - epg-gpg-program - epg-gpgsm-program) - epg-gpg-home-directory - armor textmode include-certs - cipher-algorithm digest-algorithm compress-algorithm - (list #'epg-passphrase-callback-function) - nil - nil nil nil nil nil nil nil))) - -(defun epg-context-protocol (context) - "Return the protocol used within CONTEXT." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aref (cdr context) 0)) - -(defun epg-context-program (context) - "Return the gpg or gpgsm executable used within CONTEXT." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aref (cdr context) 1)) - -(defun epg-context-home-directory (context) - "Return the GnuPG home directory used in CONTEXT." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aref (cdr context) 2)) - -(defun epg-context-armor (context) - "Return t if the output should be ASCII armored in CONTEXT." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aref (cdr context) 3)) - -(defun epg-context-textmode (context) - "Return t if canonical text mode should be used in CONTEXT." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aref (cdr context) 4)) - -(defun epg-context-include-certs (context) - "Return how many certificates should be included in an S/MIME signed message." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aref (cdr context) 5)) - -(defun epg-context-cipher-algorithm (context) - "Return the cipher algorithm in CONTEXT." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aref (cdr context) 6)) - -(defun epg-context-digest-algorithm (context) - "Return the digest algorithm in CONTEXT." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aref (cdr context) 7)) - -(defun epg-context-compress-algorithm (context) - "Return the compress algorithm in CONTEXT." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aref (cdr context) 8)) - -(defun epg-context-passphrase-callback (context) - "Return the function used to query passphrase." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aref (cdr context) 9)) - -(defun epg-context-progress-callback (context) - "Return the function which handles progress update." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aref (cdr context) 10)) - -(defun epg-context-signers (context) - "Return the list of key-id for signing." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aref (cdr context) 11)) - -(defun epg-context-sig-notations (context) - "Return the list of notations for signing." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aref (cdr context) 12)) - -(defun epg-context-process (context) - "Return the process object of `epg-gpg-program'. -This function is for internal use only." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aref (cdr context) 13)) - -(defun epg-context-output-file (context) - "Return the output file of `epg-gpg-program'. -This function is for internal use only." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aref (cdr context) 14)) - -(defun epg-context-result (context) - "Return the result of the previous cryptographic operation." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aref (cdr context) 15)) - -(defun epg-context-operation (context) - "Return the name of the current cryptographic operation." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aref (cdr context) 16)) - -(defun epg-context-pinentry-mode (context) - "Return the mode of pinentry invocation." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aref (cdr context) 17)) - -(defun epg-context-set-protocol (context protocol) - "Set the protocol used within CONTEXT." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aset (cdr context) 0 protocol)) - -(defun epg-context-set-program (context protocol) - "Set the gpg or gpgsm executable used within CONTEXT." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aset (cdr context) 1 protocol)) - -(defun epg-context-set-home-directory (context directory) - "Set the GnuPG home directory." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aset (cdr context) 2 directory)) + (epg-context--make (or protocol 'OpenPGP) + armor textmode include-certs + cipher-algorithm digest-algorithm + compress-algorithm)) (defun epg-context-set-armor (context armor) "Specify if the output should be ASCII armored in CONTEXT." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aset (cdr context) 3 armor)) + (declare (obsolete setf "25.1")) + (setf (epg-context-armor context) armor)) (defun epg-context-set-textmode (context textmode) "Specify if canonical text mode should be used in CONTEXT." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aset (cdr context) 4 textmode)) - -(defun epg-context-set-include-certs (context include-certs) - "Set how many certificates should be included in an S/MIME signed message." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aset (cdr context) 5 include-certs)) - -(defun epg-context-set-cipher-algorithm (context cipher-algorithm) - "Set the cipher algorithm in CONTEXT." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aset (cdr context) 6 cipher-algorithm)) - -(defun epg-context-set-digest-algorithm (context digest-algorithm) - "Set the digest algorithm in CONTEXT." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aset (cdr context) 7 digest-algorithm)) - -(defun epg-context-set-compress-algorithm (context compress-algorithm) - "Set the compress algorithm in CONTEXT." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aset (cdr context) 8 compress-algorithm)) + (declare (obsolete setf "25.1")) + (setf (epg-context-textmode context) textmode)) (defun epg-context-set-passphrase-callback (context passphrase-callback) @@ -384,11 +248,11 @@ If you really want to intercept passphrase query, consider installing GnuPG 1.x _along with_ GnuPG 2.x, which does passphrase query by itself and Emacs can intercept them." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aset (cdr context) 9 (if (consp passphrase-callback) - passphrase-callback - (list passphrase-callback)))) + ;; (declare (obsolete setf "25.1")) + (setf (epg-context-passphrase-callback context) + (if (consp passphrase-callback) ;FIXME: functions can also be consp! + passphrase-callback + (list passphrase-callback)))) (defun epg-context-set-progress-callback (context progress-callback) @@ -401,607 +265,119 @@ description, the character to display a progress unit, the current amount done, the total amount to be done, and the callback data (if any)." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aset (cdr context) 10 (if (consp progress-callback) - progress-callback - (list progress-callback)))) + (setf (epg-context-progress-callback context) + (if (consp progress-callback) ;FIXME: could be a function! + progress-callback + (list progress-callback)))) (defun epg-context-set-signers (context signers) "Set the list of key-id for signing." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aset (cdr context) 11 signers)) - -(defun epg-context-set-sig-notations (context notations) - "Set the list of notations for signing." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aset (cdr context) 12 notations)) - -(defun epg-context-set-process (context process) - "Set the process object of `epg-gpg-program'. -This function is for internal use only." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aset (cdr context) 13 process)) - -(defun epg-context-set-output-file (context output-file) - "Set the output file of `epg-gpg-program'. -This function is for internal use only." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aset (cdr context) 14 output-file)) - -(defun epg-context-set-result (context result) - "Set the result of the previous cryptographic operation." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aset (cdr context) 15 result)) - -(defun epg-context-set-operation (context operation) - "Set the name of the current cryptographic operation." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (aset (cdr context) 16 operation)) - -(defun epg-context-set-pinentry-mode (context mode) - "Set the mode of pinentry invocation." - (unless (eq (car-safe context) 'epg-context) - (signal 'wrong-type-argument (list 'epg-context-p context))) - (unless (memq mode '(nil ask cancel error loopback)) - (signal 'epg-error (list "Unknown pinentry mode" mode))) - (aset (cdr context) 17 mode)) - -(defun epg-make-signature (status &optional key-id) - "Return a signature object." - (cons 'epg-signature (vector status key-id nil nil nil nil nil nil nil nil - nil))) - -(defun epg-signature-status (signature) - "Return the status code of SIGNATURE." - (unless (eq (car-safe signature) 'epg-signature) - (signal 'wrong-type-argument (list 'epg-signature-p signature))) - (aref (cdr signature) 0)) - -(defun epg-signature-key-id (signature) - "Return the key-id of SIGNATURE." - (unless (eq (car-safe signature) 'epg-signature) - (signal 'wrong-type-argument (list 'epg-signature-p signature))) - (aref (cdr signature) 1)) - -(defun epg-signature-validity (signature) - "Return the validity of SIGNATURE." - (unless (eq (car-safe signature) 'epg-signature) - (signal 'wrong-type-argument (list 'epg-signature-p signature))) - (aref (cdr signature) 2)) - -(defun epg-signature-fingerprint (signature) - "Return the fingerprint of SIGNATURE." - (unless (eq (car-safe signature) 'epg-signature) - (signal 'wrong-type-argument (list 'epg-signature-p signature))) - (aref (cdr signature) 3)) - -(defun epg-signature-creation-time (signature) - "Return the creation time of SIGNATURE." - (unless (eq (car-safe signature) 'epg-signature) - (signal 'wrong-type-argument (list 'epg-signature-p signature))) - (aref (cdr signature) 4)) - -(defun epg-signature-expiration-time (signature) - "Return the expiration time of SIGNATURE." - (unless (eq (car-safe signature) 'epg-signature) - (signal 'wrong-type-argument (list 'epg-signature-p signature))) - (aref (cdr signature) 5)) - -(defun epg-signature-pubkey-algorithm (signature) - "Return the public key algorithm of SIGNATURE." - (unless (eq (car-safe signature) 'epg-signature) - (signal 'wrong-type-argument (list 'epg-signature-p signature))) - (aref (cdr signature) 6)) - -(defun epg-signature-digest-algorithm (signature) - "Return the digest algorithm of SIGNATURE." - (unless (eq (car-safe signature) 'epg-signature) - (signal 'wrong-type-argument (list 'epg-signature-p signature))) - (aref (cdr signature) 7)) - -(defun epg-signature-class (signature) - "Return the class of SIGNATURE." - (unless (eq (car-safe signature) 'epg-signature) - (signal 'wrong-type-argument (list 'epg-signature-p signature))) - (aref (cdr signature) 8)) - -(defun epg-signature-version (signature) - "Return the version of SIGNATURE." - (unless (eq (car-safe signature) 'epg-signature) - (signal 'wrong-type-argument (list 'epg-signature-p signature))) - (aref (cdr signature) 9)) - -(defun epg-sig-notations (signature) - "Return the list of notations of SIGNATURE." - (unless (eq (car-safe signature) 'epg-signature) - (signal 'wrong-type-argument (list 'epg-signature-p signature))) - (aref (cdr signature) 10)) - -(defun epg-signature-set-status (signature status) - "Set the status code of SIGNATURE." - (unless (eq (car-safe signature) 'epg-signature) - (signal 'wrong-type-argument (list 'epg-signature-p signature))) - (aset (cdr signature) 0 status)) - -(defun epg-signature-set-key-id (signature key-id) - "Set the key-id of SIGNATURE." - (unless (eq (car-safe signature) 'epg-signature) - (signal 'wrong-type-argument (list 'epg-signature-p signature))) - (aset (cdr signature) 1 key-id)) - -(defun epg-signature-set-validity (signature validity) - "Set the validity of SIGNATURE." - (unless (eq (car-safe signature) 'epg-signature) - (signal 'wrong-type-argument (list 'epg-signature-p signature))) - (aset (cdr signature) 2 validity)) - -(defun epg-signature-set-fingerprint (signature fingerprint) - "Set the fingerprint of SIGNATURE." - (unless (eq (car-safe signature) 'epg-signature) - (signal 'wrong-type-argument (list 'epg-signature-p signature))) - (aset (cdr signature) 3 fingerprint)) - -(defun epg-signature-set-creation-time (signature creation-time) - "Set the creation time of SIGNATURE." - (unless (eq (car-safe signature) 'epg-signature) - (signal 'wrong-type-argument (list 'epg-signature-p signature))) - (aset (cdr signature) 4 creation-time)) - -(defun epg-signature-set-expiration-time (signature expiration-time) - "Set the expiration time of SIGNATURE." - (unless (eq (car-safe signature) 'epg-signature) - (signal 'wrong-type-argument (list 'epg-signature-p signature))) - (aset (cdr signature) 5 expiration-time)) - -(defun epg-signature-set-pubkey-algorithm (signature pubkey-algorithm) - "Set the public key algorithm of SIGNATURE." - (unless (eq (car-safe signature) 'epg-signature) - (signal 'wrong-type-argument (list 'epg-signature-p signature))) - (aset (cdr signature) 6 pubkey-algorithm)) - -(defun epg-signature-set-digest-algorithm (signature digest-algorithm) - "Set the digest algorithm of SIGNATURE." - (unless (eq (car-safe signature) 'epg-signature) - (signal 'wrong-type-argument (list 'epg-signature-p signature))) - (aset (cdr signature) 7 digest-algorithm)) - -(defun epg-signature-set-class (signature class) - "Set the class of SIGNATURE." - (unless (eq (car-safe signature) 'epg-signature) - (signal 'wrong-type-argument (list 'epg-signature-p signature))) - (aset (cdr signature) 8 class)) - -(defun epg-signature-set-version (signature version) - "Set the version of SIGNATURE." - (unless (eq (car-safe signature) 'epg-signature) - (signal 'wrong-type-argument (list 'epg-signature-p signature))) - (aset (cdr signature) 9 version)) - -(defun epg-signature-set-notations (signature notations) - "Set the list of notations of SIGNATURE." - (unless (eq (car-safe signature) 'epg-signature) - (signal 'wrong-type-argument (list 'epg-signature-p signature))) - (aset (cdr signature) 10 notations)) - -(defun epg-make-new-signature (type pubkey-algorithm digest-algorithm - class creation-time fingerprint) - "Return a new signature object." - (cons 'epg-new-signature (vector type pubkey-algorithm digest-algorithm - class creation-time fingerprint))) - -(defun epg-new-signature-type (new-signature) - "Return the type of NEW-SIGNATURE." - (unless (eq (car-safe new-signature) 'epg-new-signature) - (signal 'wrong-type-argument (list 'epg-new-signature-p new-signature))) - (aref (cdr new-signature) 0)) - -(defun epg-new-signature-pubkey-algorithm (new-signature) - "Return the public key algorithm of NEW-SIGNATURE." - (unless (eq (car-safe new-signature) 'epg-new-signature) - (signal 'wrong-type-argument (list 'epg-new-signature-p new-signature))) - (aref (cdr new-signature) 1)) - -(defun epg-new-signature-digest-algorithm (new-signature) - "Return the digest algorithm of NEW-SIGNATURE." - (unless (eq (car-safe new-signature) 'epg-new-signature) - (signal 'wrong-type-argument (list 'epg-new-signature-p new-signature))) - (aref (cdr new-signature) 2)) - -(defun epg-new-signature-class (new-signature) - "Return the class of NEW-SIGNATURE." - (unless (eq (car-safe new-signature) 'epg-new-signature) - (signal 'wrong-type-argument (list 'epg-new-signature-p new-signature))) - (aref (cdr new-signature) 3)) - -(defun epg-new-signature-creation-time (new-signature) - "Return the creation time of NEW-SIGNATURE." - (unless (eq (car-safe new-signature) 'epg-new-signature) - (signal 'wrong-type-argument (list 'epg-new-signature-p new-signature))) - (aref (cdr new-signature) 4)) - -(defun epg-new-signature-fingerprint (new-signature) - "Return the fingerprint of NEW-SIGNATURE." - (unless (eq (car-safe new-signature) 'epg-new-signature) - (signal 'wrong-type-argument (list 'epg-new-signature-p new-signature))) - (aref (cdr new-signature) 5)) - -(defun epg-make-key (owner-trust) - "Return a key object." - (cons 'epg-key (vector owner-trust nil nil))) - -(defun epg-key-owner-trust (key) - "Return the owner trust of KEY." - (unless (eq (car-safe key) 'epg-key) - (signal 'wrong-type-argument (list 'epg-key-p key))) - (aref (cdr key) 0)) - -(defun epg-key-sub-key-list (key) - "Return the sub key list of KEY." - (unless (eq (car-safe key) 'epg-key) - (signal 'wrong-type-argument (list 'epg-key-p key))) - (aref (cdr key) 1)) - -(defun epg-key-user-id-list (key) - "Return the user ID list of KEY." - (unless (eq (car-safe key) 'epg-key) - (signal 'wrong-type-argument (list 'epg-key-p key))) - (aref (cdr key) 2)) - -(defun epg-key-set-sub-key-list (key sub-key-list) - "Set the sub key list of KEY." - (unless (eq (car-safe key) 'epg-key) - (signal 'wrong-type-argument (list 'epg-key-p key))) - (aset (cdr key) 1 sub-key-list)) - -(defun epg-key-set-user-id-list (key user-id-list) - "Set the user ID list of KEY." - (unless (eq (car-safe key) 'epg-key) - (signal 'wrong-type-argument (list 'epg-key-p key))) - (aset (cdr key) 2 user-id-list)) - -(defun epg-make-sub-key (validity capability secret-p algorithm length id - creation-time expiration-time) - "Return a sub key object." - (cons 'epg-sub-key - (vector validity capability secret-p algorithm length id creation-time - expiration-time nil))) - -(defun epg-sub-key-validity (sub-key) - "Return the validity of SUB-KEY." - (unless (eq (car-safe sub-key) 'epg-sub-key) - (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key))) - (aref (cdr sub-key) 0)) - -(defun epg-sub-key-capability (sub-key) - "Return the capability of SUB-KEY." - (unless (eq (car-safe sub-key) 'epg-sub-key) - (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key))) - (aref (cdr sub-key) 1)) - -(defun epg-sub-key-secret-p (sub-key) - "Return non-nil if SUB-KEY is a secret key." - (unless (eq (car-safe sub-key) 'epg-sub-key) - (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key))) - (aref (cdr sub-key) 2)) - -(defun epg-sub-key-algorithm (sub-key) - "Return the algorithm of SUB-KEY." - (unless (eq (car-safe sub-key) 'epg-sub-key) - (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key))) - (aref (cdr sub-key) 3)) - -(defun epg-sub-key-length (sub-key) - "Return the length of SUB-KEY." - (unless (eq (car-safe sub-key) 'epg-sub-key) - (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key))) - (aref (cdr sub-key) 4)) - -(defun epg-sub-key-id (sub-key) - "Return the ID of SUB-KEY." - (unless (eq (car-safe sub-key) 'epg-sub-key) - (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key))) - (aref (cdr sub-key) 5)) - -(defun epg-sub-key-creation-time (sub-key) - "Return the creation time of SUB-KEY." - (unless (eq (car-safe sub-key) 'epg-sub-key) - (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key))) - (aref (cdr sub-key) 6)) - -(defun epg-sub-key-expiration-time (sub-key) - "Return the expiration time of SUB-KEY." - (unless (eq (car-safe sub-key) 'epg-sub-key) - (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key))) - (aref (cdr sub-key) 7)) - -(defun epg-sub-key-fingerprint (sub-key) - "Return the fingerprint of SUB-KEY." - (unless (eq (car-safe sub-key) 'epg-sub-key) - (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key))) - (aref (cdr sub-key) 8)) - -(defun epg-sub-key-set-fingerprint (sub-key fingerprint) - "Set the fingerprint of SUB-KEY. -This function is for internal use only." - (unless (eq (car-safe sub-key) 'epg-sub-key) - (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key))) - (aset (cdr sub-key) 8 fingerprint)) - -(defun epg-make-user-id (validity string) - "Return a user ID object." - (cons 'epg-user-id (vector validity string nil))) - -(defun epg-user-id-validity (user-id) - "Return the validity of USER-ID." - (unless (eq (car-safe user-id) 'epg-user-id) - (signal 'wrong-type-argument (list 'epg-user-id-p user-id))) - (aref (cdr user-id) 0)) - -(defun epg-user-id-string (user-id) - "Return the name of USER-ID." - (unless (eq (car-safe user-id) 'epg-user-id) - (signal 'wrong-type-argument (list 'epg-user-id-p user-id))) - (aref (cdr user-id) 1)) - -(defun epg-user-id-signature-list (user-id) - "Return the signature list of USER-ID." - (unless (eq (car-safe user-id) 'epg-user-id) - (signal 'wrong-type-argument (list 'epg-user-id-p user-id))) - (aref (cdr user-id) 2)) - -(defun epg-user-id-set-signature-list (user-id signature-list) - "Set the signature list of USER-ID." - (unless (eq (car-safe user-id) 'epg-user-id) - (signal 'wrong-type-argument (list 'epg-user-id-p user-id))) - (aset (cdr user-id) 2 signature-list)) - -(defun epg-make-key-signature (validity pubkey-algorithm key-id creation-time - expiration-time user-id class - exportable-p) - "Return a key signature object." - (cons 'epg-key-signature - (vector validity pubkey-algorithm key-id creation-time expiration-time - user-id class exportable-p))) - -(defun epg-key-signature-validity (key-signature) - "Return the validity of KEY-SIGNATURE." - (unless (eq (car-safe key-signature) 'epg-key-signature) - (signal 'wrong-type-argument (list 'epg-key-signature-p key-signature))) - (aref (cdr key-signature) 0)) - -(defun epg-key-signature-pubkey-algorithm (key-signature) - "Return the public key algorithm of KEY-SIGNATURE." - (unless (eq (car-safe key-signature) 'epg-key-signature) - (signal 'wrong-type-argument (list 'epg-key-signature-p key-signature))) - (aref (cdr key-signature) 1)) - -(defun epg-key-signature-key-id (key-signature) - "Return the key-id of KEY-SIGNATURE." - (unless (eq (car-safe key-signature) 'epg-key-signature) - (signal 'wrong-type-argument (list 'epg-key-signature-p key-signature))) - (aref (cdr key-signature) 2)) - -(defun epg-key-signature-creation-time (key-signature) - "Return the creation time of KEY-SIGNATURE." - (unless (eq (car-safe key-signature) 'epg-key-signature) - (signal 'wrong-type-argument (list 'epg-key-signature-p key-signature))) - (aref (cdr key-signature) 3)) - -(defun epg-key-signature-expiration-time (key-signature) - "Return the expiration time of KEY-SIGNATURE." - (unless (eq (car-safe key-signature) 'epg-key-signature) - (signal 'wrong-type-argument (list 'epg-key-signature-p key-signature))) - (aref (cdr key-signature) 4)) - -(defun epg-key-signature-user-id (key-signature) - "Return the user-id of KEY-SIGNATURE." - (unless (eq (car-safe key-signature) 'epg-key-signature) - (signal 'wrong-type-argument (list 'epg-key-signature-p key-signature))) - (aref (cdr key-signature) 5)) - -(defun epg-key-signature-class (key-signature) - "Return the class of KEY-SIGNATURE." - (unless (eq (car-safe key-signature) 'epg-key-signature) - (signal 'wrong-type-argument (list 'epg-key-signature-p key-signature))) - (aref (cdr key-signature) 6)) - -(defun epg-key-signature-exportable-p (key-signature) - "Return t if KEY-SIGNATURE is exportable." - (unless (eq (car-safe key-signature) 'epg-key-signature) - (signal 'wrong-type-argument (list 'epg-key-signature-p key-signature))) - (aref (cdr key-signature) 7)) - -(defun epg-make-sig-notation (name value &optional human-readable - critical) - "Return a notation object." - (cons 'epg-sig-notation (vector name value human-readable critical))) - -(defun epg-sig-notation-name (sig-notation) - "Return the name of SIG-NOTATION." - (unless (eq (car-safe sig-notation) 'epg-sig-notation) - (signal 'wrong-type-argument (list 'epg-sig-notation-p - sig-notation))) - (aref (cdr sig-notation) 0)) - -(defun epg-sig-notation-value (sig-notation) - "Return the value of SIG-NOTATION." - (unless (eq (car-safe sig-notation) 'epg-sig-notation) - (signal 'wrong-type-argument (list 'epg-sig-notation-p - sig-notation))) - (aref (cdr sig-notation) 1)) - -(defun epg-sig-notation-human-readable (sig-notation) - "Return the human-readable of SIG-NOTATION." - (unless (eq (car-safe sig-notation) 'epg-sig-notation) - (signal 'wrong-type-argument (list 'epg-sig-notation-p - sig-notation))) - (aref (cdr sig-notation) 2)) - -(defun epg-sig-notation-critical (sig-notation) - "Return the critical of SIG-NOTATION." - (unless (eq (car-safe sig-notation) 'epg-sig-notation) - (signal 'wrong-type-argument (list 'epg-sig-notation-p - sig-notation))) - (aref (cdr sig-notation) 3)) - -(defun epg-sig-notation-set-value (sig-notation value) - "Set the value of SIG-NOTATION." - (unless (eq (car-safe sig-notation) 'epg-sig-notation) - (signal 'wrong-type-argument (list 'epg-sig-notation-p - sig-notation))) - (aset (cdr sig-notation) 1 value)) - -(defun epg-make-import-status (fingerprint &optional reason new user-id - signature sub-key secret) - "Return an import status object." - (cons 'epg-import-status (vector fingerprint reason new user-id signature - sub-key secret))) - -(defun epg-import-status-fingerprint (import-status) - "Return the fingerprint of the key that was considered." - (unless (eq (car-safe import-status) 'epg-import-status) - (signal 'wrong-type-argument (list 'epg-import-status-p import-status))) - (aref (cdr import-status) 0)) - -(defun epg-import-status-reason (import-status) - "Return the reason code for import failure." - (unless (eq (car-safe import-status) 'epg-import-status) - (signal 'wrong-type-argument (list 'epg-import-status-p import-status))) - (aref (cdr import-status) 1)) - -(defun epg-import-status-new (import-status) - "Return t if the imported key was new." - (unless (eq (car-safe import-status) 'epg-import-status) - (signal 'wrong-type-argument (list 'epg-import-status-p import-status))) - (aref (cdr import-status) 2)) - -(defun epg-import-status-user-id (import-status) - "Return t if the imported key contained new user IDs." - (unless (eq (car-safe import-status) 'epg-import-status) - (signal 'wrong-type-argument (list 'epg-import-status-p import-status))) - (aref (cdr import-status) 3)) - -(defun epg-import-status-signature (import-status) - "Return t if the imported key contained new signatures." - (unless (eq (car-safe import-status) 'epg-import-status) - (signal 'wrong-type-argument (list 'epg-import-status-p import-status))) - (aref (cdr import-status) 4)) - -(defun epg-import-status-sub-key (import-status) - "Return t if the imported key contained new sub keys." - (unless (eq (car-safe import-status) 'epg-import-status) - (signal 'wrong-type-argument (list 'epg-import-status-p import-status))) - (aref (cdr import-status) 5)) - -(defun epg-import-status-secret (import-status) - "Return t if the imported key contained a secret key." - (unless (eq (car-safe import-status) 'epg-import-status) - (signal 'wrong-type-argument (list 'epg-import-status-p import-status))) - (aref (cdr import-status) 6)) - -(defun epg-make-import-result (considered no-user-id imported imported-rsa - unchanged new-user-ids new-sub-keys - new-signatures new-revocations - secret-read secret-imported - secret-unchanged not-imported - imports) - "Return an import result object." - (cons 'epg-import-result (vector considered no-user-id imported imported-rsa - unchanged new-user-ids new-sub-keys - new-signatures new-revocations secret-read - secret-imported secret-unchanged - not-imported imports))) - -(defun epg-import-result-considered (import-result) - "Return the total number of considered keys." - (unless (eq (car-safe import-result) 'epg-import-result) - (signal 'wrong-type-argument (list 'epg-import-result-p import-result))) - (aref (cdr import-result) 0)) - -(defun epg-import-result-no-user-id (import-result) - "Return the number of keys without user ID." - (unless (eq (car-safe import-result) 'epg-import-result) - (signal 'wrong-type-argument (list 'epg-import-result-p import-result))) - (aref (cdr import-result) 1)) - -(defun epg-import-result-imported (import-result) - "Return the number of imported keys." - (unless (eq (car-safe import-result) 'epg-import-result) - (signal 'wrong-type-argument (list 'epg-import-result-p import-result))) - (aref (cdr import-result) 2)) - -(defun epg-import-result-imported-rsa (import-result) - "Return the number of imported RSA keys." - (unless (eq (car-safe import-result) 'epg-import-result) - (signal 'wrong-type-argument (list 'epg-import-result-p import-result))) - (aref (cdr import-result) 3)) - -(defun epg-import-result-unchanged (import-result) - "Return the number of unchanged keys." - (unless (eq (car-safe import-result) 'epg-import-result) - (signal 'wrong-type-argument (list 'epg-import-result-p import-result))) - (aref (cdr import-result) 4)) - -(defun epg-import-result-new-user-ids (import-result) - "Return the number of new user IDs." - (unless (eq (car-safe import-result) 'epg-import-result) - (signal 'wrong-type-argument (list 'epg-import-result-p import-result))) - (aref (cdr import-result) 5)) - -(defun epg-import-result-new-sub-keys (import-result) - "Return the number of new sub keys." - (unless (eq (car-safe import-result) 'epg-import-result) - (signal 'wrong-type-argument (list 'epg-import-result-p import-result))) - (aref (cdr import-result) 6)) - -(defun epg-import-result-new-signatures (import-result) - "Return the number of new signatures." - (unless (eq (car-safe import-result) 'epg-import-result) - (signal 'wrong-type-argument (list 'epg-import-result-p import-result))) - (aref (cdr import-result) 7)) - -(defun epg-import-result-new-revocations (import-result) - "Return the number of new revocations." - (unless (eq (car-safe import-result) 'epg-import-result) - (signal 'wrong-type-argument (list 'epg-import-result-p import-result))) - (aref (cdr import-result) 8)) - -(defun epg-import-result-secret-read (import-result) - "Return the total number of secret keys read." - (unless (eq (car-safe import-result) 'epg-import-result) - (signal 'wrong-type-argument (list 'epg-import-result-p import-result))) - (aref (cdr import-result) 9)) - -(defun epg-import-result-secret-imported (import-result) - "Return the number of imported secret keys." - (unless (eq (car-safe import-result) 'epg-import-result) - (signal 'wrong-type-argument (list 'epg-import-result-p import-result))) - (aref (cdr import-result) 10)) - -(defun epg-import-result-secret-unchanged (import-result) - "Return the number of unchanged secret keys." - (unless (eq (car-safe import-result) 'epg-import-result) - (signal 'wrong-type-argument (list 'epg-import-result-p import-result))) - (aref (cdr import-result) 11)) - -(defun epg-import-result-not-imported (import-result) - "Return the number of keys not imported." - (unless (eq (car-safe import-result) 'epg-import-result) - (signal 'wrong-type-argument (list 'epg-import-result-p import-result))) - (aref (cdr import-result) 12)) - -(defun epg-import-result-imports (import-result) - "Return the list of `epg-import-status' objects." - (unless (eq (car-safe import-result) 'epg-import-result) - (signal 'wrong-type-argument (list 'epg-import-result-p import-result))) - (aref (cdr import-result) 13)) + (declare (obsolete setf "25.1")) + (setf (epg-context-signers context) signers)) + +(cl-defstruct (epg-signature + (:constructor nil) + (:constructor epg-make-signature + (status &optional key-id)) + (:copier nil) + (:predicate nil)) + status + key-id + validity + fingerprint + creation-time + expiration-time + pubkey-algorithm + digest-algorithm + class + version + notations) + +(cl-defstruct (epg-new-signature + (:constructor nil) + (:constructor epg-make-new-signature + (type pubkey-algorithm digest-algorithm + class creation-time fingerprint)) + (:copier nil) + (:predicate nil)) + (type nil :read-only t) + (pubkey-algorithm nil :read-only t) + (digest-algorithm nil :read-only t) + (class nil :read-only t) + (creation-time nil :read-only t) + (fingerprint nil :read-only t)) + +(cl-defstruct (epg-key + (:constructor nil) + (:constructor epg-make-key (owner-trust)) + (:copier nil) + (:predicate nil)) + (owner-trust nil :read-only t) + sub-key-list user-id-list) + +(cl-defstruct (epg-sub-key + (:constructor nil) + (:constructor epg-make-sub-key + (validity capability secret-p algorithm length id + creation-time expiration-time)) + (:copier nil) + (:predicate nil)) + validity capability secret-p algorithm length id + creation-time expiration-time fingerprint) + +(cl-defstruct (epg-user-id + (:constructor nil) + (:constructor epg-make-user-id (validity string)) + (:copier nil) + (:predicate nil)) + validity string signature-list) + +(cl-defstruct (epg-key-signature + (:constructor nil) + (:constructor epg-make-key-signature + (validity pubkey-algorithm key-id creation-time + expiration-time user-id class + exportable-p)) + (:copier nil) + (:predicate nil)) + validity pubkey-algorithm key-id creation-time + expiration-time user-id class + exportable-p) + +(cl-defstruct (epg-sig-notation + (:constructor nil) + (:constructor epg-make-sig-notation + (name value &optional human-readable critical)) + (:copier nil) + (:predicate nil)) + name value human-readable critical) + +(cl-defstruct (epg-import-status + (:constructor nil) + (:constructor epg-make-import-status + (fingerprint + &optional reason new user-id signature sub-key secret)) + (:copier nil) + (:predicate nil)) + fingerprint reason new user-id signature sub-key secret) + +(cl-defstruct (epg-import-result + (:constructor nil) + (:constructor epg-make-import-result + (considered no-user-id imported imported-rsa + unchanged new-user-ids new-sub-keys + new-signatures new-revocations + secret-read secret-imported + secret-unchanged not-imported + imports)) + (:copier nil) + (:predicate nil)) + considered no-user-id imported imported-rsa + unchanged new-user-ids new-sub-keys + new-signatures new-revocations + secret-read secret-imported + secret-unchanged not-imported + imports) (defun epg-context-result-for (context name) "Return the result of CONTEXT associated with NAME." @@ -1013,7 +389,7 @@ (entry (assq name result))) (if entry (setcdr entry value) - (epg-context-set-result context (cons (cons name value) result))))) + (setf (epg-context-result context) (cons (cons name value) result))))) (defun epg-signature-to-string (signature) "Convert SIGNATURE to a human readable string." @@ -1268,7 +644,7 @@ (setq process (apply #'start-process "epg" buffer (epg-context-program context) args))) (set-process-filter process #'epg--process-filter) - (epg-context-set-process context process))) + (setf (epg-context-process context) process))) (defun epg--process-filter (process input) (if epg-debug @@ -1346,7 +722,7 @@ (if (and (epg-context-process context) (buffer-live-p (process-buffer (epg-context-process context)))) (kill-buffer (process-buffer (epg-context-process context)))) - (epg-context-set-process context nil)) + (setf (epg-context-process context) nil)) (defun epg-delete-output-file (context) "Delete the output file of CONTEXT." @@ -1540,7 +916,7 @@ (if (and signature (eq (epg-signature-status signature) 'error) (equal (epg-signature-key-id signature) string)) - (epg-signature-set-status signature 'no-pubkey))) + (setf (epg-signature-status signature) 'no-pubkey))) (epg-context-set-result-for context 'error (cons (cons 'no-pubkey string) @@ -1567,21 +943,16 @@ 'verify (cons signature (epg-context-result-for context 'verify))) - (epg-signature-set-key-id - signature - (match-string 1 string)) - (epg-signature-set-pubkey-algorithm - signature - (string-to-number (match-string 2 string))) - (epg-signature-set-digest-algorithm - signature - (string-to-number (match-string 3 string))) - (epg-signature-set-class - signature - (string-to-number (match-string 4 string) 16)) - (epg-signature-set-creation-time - signature - (epg--time-from-seconds (match-string 5 string)))))) + (setf (epg-signature-key-id signature) + (match-string 1 string)) + (setf (epg-signature-pubkey-algorithm signature) + (string-to-number (match-string 2 string))) + (setf (epg-signature-digest-algorithm signature) + (string-to-number (match-string 3 string))) + (setf (epg-signature-class signature) + (string-to-number (match-string 4 string) 16)) + (setf (epg-signature-creation-time signature) + (epg--time-from-seconds (match-string 5 string)))))) (defun epg--status-VALIDSIG (context string) (let ((signature (car (epg-context-result-for context 'verify)))) @@ -1591,81 +962,70 @@ \\([0-9]+\\) [^ ]+ \\([0-9]+\\) \\([0-9]+\\) \\([0-9A-Fa-f][0-9A-Fa-f]\\) \ \\(.*\\)" string)) - (epg-signature-set-fingerprint - signature - (match-string 1 string)) - (epg-signature-set-creation-time - signature - (epg--time-from-seconds (match-string 2 string))) + (setf (epg-signature-fingerprint signature) + (match-string 1 string)) + (setf (epg-signature-creation-time signature) + (epg--time-from-seconds (match-string 2 string))) (unless (equal (match-string 3 string) "0") - (epg-signature-set-expiration-time - signature - (epg--time-from-seconds (match-string 3 string)))) - (epg-signature-set-version - signature - (string-to-number (match-string 4 string))) - (epg-signature-set-pubkey-algorithm - signature - (string-to-number (match-string 5 string))) - (epg-signature-set-digest-algorithm - signature - (string-to-number (match-string 6 string))) - (epg-signature-set-class - signature - (string-to-number (match-string 7 string) 16))))) + (setf (epg-signature-expiration-time signature) + (epg--time-from-seconds (match-string 3 string)))) + (setf (epg-signature-version signature) + (string-to-number (match-string 4 string))) + (setf (epg-signature-pubkey-algorithm signature) + (string-to-number (match-string 5 string))) + (setf (epg-signature-digest-algorithm signature) + (string-to-number (match-string 6 string))) + (setf (epg-signature-class signature) + (string-to-number (match-string 7 string) 16))))) (defun epg--status-TRUST_UNDEFINED (context _string) (let ((signature (car (epg-context-result-for context 'verify)))) (if (and signature (eq (epg-signature-status signature) 'good)) - (epg-signature-set-validity signature 'undefined)))) + (setf (epg-signature-validity signature) 'undefined)))) (defun epg--status-TRUST_NEVER (context _string) (let ((signature (car (epg-context-result-for context 'verify)))) (if (and signature (eq (epg-signature-status signature) 'good)) - (epg-signature-set-validity signature 'never)))) + (setf (epg-signature-validity signature) 'never)))) (defun epg--status-TRUST_MARGINAL (context _string) (let ((signature (car (epg-context-result-for context 'verify)))) (if (and signature (eq (epg-signature-status signature) 'marginal)) - (epg-signature-set-validity signature 'marginal)))) + (setf (epg-signature-validity signature) 'marginal)))) (defun epg--status-TRUST_FULLY (context _string) (let ((signature (car (epg-context-result-for context 'verify)))) (if (and signature (eq (epg-signature-status signature) 'good)) - (epg-signature-set-validity signature 'full)))) + (setf (epg-signature-validity signature) 'full)))) (defun epg--status-TRUST_ULTIMATE (context _string) (let ((signature (car (epg-context-result-for context 'verify)))) (if (and signature (eq (epg-signature-status signature) 'good)) - (epg-signature-set-validity signature 'ultimate)))) + (setf (epg-signature-validity signature) 'ultimate)))) (defun epg--status-NOTATION_NAME (context string) (let ((signature (car (epg-context-result-for context 'verify)))) (if signature - (epg-signature-set-notations - signature - (cons (epg-make-sig-notation string nil t nil) - (epg-sig-notations signature)))))) + (push (epg-make-sig-notation string nil t nil) + (epg-signature-notations signature))))) (defun epg--status-NOTATION_DATA (context string) (let ((signature (car (epg-context-result-for context 'verify))) notation) (if (and signature - (setq notation (car (epg-sig-notations signature)))) - (epg-sig-notation-set-value notation string)))) + (setq notation (car (epg-signature-notations signature)))) + (setf (epg-sig-notation-value notation) string)))) (defun epg--status-POLICY_URL (context string) (let ((signature (car (epg-context-result-for context 'verify)))) (if signature - (epg-signature-set-notations - signature - (cons (epg-make-sig-notation nil string t nil) - (epg-sig-notations signature)))))) + (push (epg-make-sig-notation nil string t nil) + (epg-signature-notations signature))))) (defun epg--status-PROGRESS (context string) (if (and (epg-context-progress-callback context) @@ -1944,15 +1304,11 @@ (cdr (assq (string-to-char (aref (car lines) 8)) epg-key-validity-alist)))) keys)) - (epg-key-set-sub-key-list - (car keys) - (cons (epg--make-sub-key-1 (car lines)) - (epg-key-sub-key-list (car keys))))) + (push (epg--make-sub-key-1 (car lines)) + (epg-key-sub-key-list (car keys)))) ((member (aref (car lines) 0) '("sub" "ssb")) - (epg-key-set-sub-key-list - (car keys) - (cons (epg--make-sub-key-1 (car lines)) - (epg-key-sub-key-list (car keys))))) + (push (epg--make-sub-key-1 (car lines)) + (epg-key-sub-key-list (car keys)))) ((equal (aref (car lines) 0) "uid") ;; Decode the UID name as a backslash escaped UTF-8 string, ;; generated by GnuPG/GpgSM. @@ -1967,52 +1323,42 @@ 'utf-8)) (error (setq string (aref (car lines) 9)))) - (epg-key-set-user-id-list - (car keys) - (cons (epg-make-user-id - (if (aref (car lines) 1) - (cdr (assq (string-to-char (aref (car lines) 1)) - epg-key-validity-alist))) - (if cert - (condition-case nil - (epg-dn-from-string string) - (error string)) - string)) - (epg-key-user-id-list (car keys))))) + (push (epg-make-user-id + (if (aref (car lines) 1) + (cdr (assq (string-to-char (aref (car lines) 1)) + epg-key-validity-alist))) + (if cert + (condition-case nil + (epg-dn-from-string string) + (error string)) + string)) + (epg-key-user-id-list (car keys)))) ((equal (aref (car lines) 0) "fpr") - (epg-sub-key-set-fingerprint (car (epg-key-sub-key-list (car keys))) - (aref (car lines) 9))) + (setf (epg-sub-key-fingerprint (car (epg-key-sub-key-list (car keys)))) + (aref (car lines) 9))) ((equal (aref (car lines) 0) "sig") - (epg-user-id-set-signature-list - (car (epg-key-user-id-list (car keys))) - (cons - (epg-make-key-signature - (if (aref (car lines) 1) - (cdr (assq (string-to-char (aref (car lines) 1)) - epg-key-validity-alist))) - (string-to-number (aref (car lines) 3)) - (aref (car lines) 4) - (epg--time-from-seconds (aref (car lines) 5)) - (epg--time-from-seconds (aref (car lines) 6)) - (aref (car lines) 9) - (string-to-number (aref (car lines) 10) 16) - (eq (aref (aref (car lines) 10) 2) ?x)) - (epg-user-id-signature-list - (car (epg-key-user-id-list (car keys)))))))) + (push + (epg-make-key-signature + (if (aref (car lines) 1) + (cdr (assq (string-to-char (aref (car lines) 1)) + epg-key-validity-alist))) + (string-to-number (aref (car lines) 3)) + (aref (car lines) 4) + (epg--time-from-seconds (aref (car lines) 5)) + (epg--time-from-seconds (aref (car lines) 6)) + (aref (car lines) 9) + (string-to-number (aref (car lines) 10) 16) + (eq (aref (aref (car lines) 10) 2) ?x)) + (epg-user-id-signature-list + (car (epg-key-user-id-list (car keys))))))) (setq lines (cdr lines))) (setq keys (nreverse keys) pointer keys) (while pointer - (epg-key-set-sub-key-list - (car pointer) - (nreverse (epg-key-sub-key-list (car pointer)))) - (setq pointer-1 (epg-key-set-user-id-list - (car pointer) - (nreverse (epg-key-user-id-list (car pointer))))) + (epg--gv-nreverse (epg-key-sub-key-list (car pointer))) + (setq pointer-1 (epg--gv-nreverse (epg-key-user-id-list (car pointer)))) (while pointer-1 - (epg-user-id-set-signature-list - (car pointer-1) - (nreverse (epg-user-id-signature-list (car pointer-1)))) + (epg--gv-nreverse (epg-user-id-signature-list (car pointer-1))) (setq pointer-1 (cdr pointer-1))) (setq pointer (cdr pointer))) keys)) @@ -2114,8 +1460,8 @@ `epg-decrypt-file' or `epg-decrypt-string' instead." (unless (epg-data-file cipher) (error "Not a file")) - (epg-context-set-operation context 'decrypt) - (epg-context-set-result context nil) + (setf (epg-context-operation context) 'decrypt) + (setf (epg-context-result context) nil) (epg--start context (list "--decrypt" "--" (epg-data-file cipher))) ;; `gpgsm' does not read passphrase from stdin, so waiting is not needed. (unless (eq (epg-context-protocol context) 'CMS) @@ -2135,10 +1481,8 @@ If PLAIN is nil, it returns the result as a string." (unwind-protect (progn - (if plain - (epg-context-set-output-file context plain) - (epg-context-set-output-file context - (epg--make-temp-file "epg-output"))) + (setf (epg-context-output-file context) + (or plain (epg--make-temp-file "epg-output"))) (epg-start-decrypt context (epg-make-data-from-file cipher)) (epg-wait-for-completion context) (epg--check-error-for-decrypt context) @@ -2155,8 +1499,8 @@ (unwind-protect (progn (write-region cipher nil input-file nil 'quiet) - (epg-context-set-output-file context - (epg--make-temp-file "epg-output")) + (setf (epg-context-output-file context) + (epg--make-temp-file "epg-output")) (epg-start-decrypt context (epg-make-data-from-file input-file)) (epg-wait-for-completion context) (epg--check-error-for-decrypt context) @@ -2178,8 +1522,8 @@ `epg-reset' to clear a temporary output file. If you are unsure, use synchronous version of this function `epg-verify-file' or `epg-verify-string' instead." - (epg-context-set-operation context 'verify) - (epg-context-set-result context nil) + (setf (epg-context-operation context) 'verify) + (setf (epg-context-result context) nil) (if signed-text ;; Detached signature. (if (epg-data-file signed-text) @@ -2226,10 +1570,8 @@ which will return a list of `epg-signature' object." (unwind-protect (progn - (if plain - (epg-context-set-output-file context plain) - (epg-context-set-output-file context - (epg--make-temp-file "epg-output"))) + (setf (epg-context-output-file context) + (or plain (epg--make-temp-file "epg-output"))) (if signed-text (epg-start-verify context (epg-make-data-from-file signature) @@ -2265,8 +1607,8 @@ input-file) (unwind-protect (progn - (epg-context-set-output-file context - (epg--make-temp-file "epg-output")) + (setf (epg-context-output-file context) + (epg--make-temp-file "epg-output")) (if signed-text (progn (setq input-file (epg--make-temp-file "epg-signature")) @@ -2296,8 +1638,8 @@ `epg-reset' to clear a temporary output file. If you are unsure, use synchronous version of this function `epg-sign-file' or `epg-sign-string' instead." - (epg-context-set-operation context 'sign) - (epg-context-set-result context nil) + (setf (epg-context-operation context) 'sign) + (setf (epg-context-result context) nil) (unless (memq mode '(t detached nil normal)) ;i.e. cleartext (epg-context-set-armor context nil) (epg-context-set-textmode context nil)) @@ -2336,10 +1678,8 @@ Otherwise, it makes a cleartext signature." (unwind-protect (progn - (if signature - (epg-context-set-output-file context signature) - (epg-context-set-output-file context - (epg--make-temp-file "epg-output"))) + (setf (epg-context-output-file context) + (or signature (epg--make-temp-file "epg-output"))) (epg-start-sign context (epg-make-data-from-file plain) mode) (epg-wait-for-completion context) (unless (epg-context-result-for context 'sign) @@ -2368,8 +1708,8 @@ (coding-system-for-write 'binary)) (unwind-protect (progn - (epg-context-set-output-file context - (epg--make-temp-file "epg-output")) + (setf (epg-context-output-file context) + (epg--make-temp-file "epg-output")) (if input-file (write-region plain nil input-file nil 'quiet)) (epg-start-sign context @@ -2400,8 +1740,8 @@ `epg-reset' to clear a temporary output file. If you are unsure, use synchronous version of this function `epg-encrypt-file' or `epg-encrypt-string' instead." - (epg-context-set-operation context 'encrypt) - (epg-context-set-result context nil) + (setf (epg-context-operation context) 'encrypt) + (setf (epg-context-result context) nil) (epg--start context (append (if always-trust '("--always-trust")) (if recipients '("--encrypt") '("--symmetric")) @@ -2445,10 +1785,8 @@ If RECIPIENTS is nil, it performs symmetric encryption." (unwind-protect (progn - (if cipher - (epg-context-set-output-file context cipher) - (epg-context-set-output-file context - (epg--make-temp-file "epg-output"))) + (setf (epg-context-output-file context) + (or cipher (epg--make-temp-file "epg-output"))) (epg-start-encrypt context (epg-make-data-from-file plain) recipients sign always-trust) (epg-wait-for-completion context) @@ -2482,8 +1820,8 @@ (coding-system-for-write 'binary)) (unwind-protect (progn - (epg-context-set-output-file context - (epg--make-temp-file "epg-output")) + (setf (epg-context-output-file context) + (epg--make-temp-file "epg-output")) (if input-file (write-region plain nil input-file nil 'quiet)) (epg-start-encrypt context @@ -2514,8 +1852,8 @@ `epg-reset' to clear a temporary output file. If you are unsure, use synchronous version of this function `epg-export-keys-to-file' or `epg-export-keys-to-string' instead." - (epg-context-set-operation context 'export-keys) - (epg-context-set-result context nil) + (setf (epg-context-operation context) 'export-keys) + (setf (epg-context-result context) nil) (epg--start context (cons "--export" (mapcar (lambda (key) @@ -2527,10 +1865,8 @@ "Extract public KEYS." (unwind-protect (progn - (if file - (epg-context-set-output-file context file) - (epg-context-set-output-file context - (epg--make-temp-file "epg-output"))) + (setf (epg-context-output-file context) + (or file (epg--make-temp-file "epg-output"))) (epg-start-export-keys context keys) (epg-wait-for-completion context) (let ((errors (epg-context-result-for context 'error))) @@ -2557,8 +1893,8 @@ `epg-reset' to clear a temporary output file. If you are unsure, use synchronous version of this function `epg-import-keys-from-file' or `epg-import-keys-from-string' instead." - (epg-context-set-operation context 'import-keys) - (epg-context-set-result context nil) + (setf (epg-context-operation context) 'import-keys) + (setf (epg-context-result context) nil) (epg--start context (if (epg-data-file keys) (list "--import" "--" (epg-data-file keys)) (list "--import"))) @@ -2598,8 +1934,8 @@ `epg-reset' to clear a temporary output file. If you are unsure, use synchronous version of this function `epg-receive-keys' instead." - (epg-context-set-operation context 'receive-keys) - (epg-context-set-result context nil) + (setf (epg-context-operation context) 'receive-keys) + (setf (epg-context-result context) nil) (epg--start context (cons "--recv-keys" key-id-list))) (defun epg-receive-keys (context keys) @@ -2626,8 +1962,8 @@ `epg-reset' to clear a temporary output file. If you are unsure, use synchronous version of this function `epg-delete-keys' instead." - (epg-context-set-operation context 'delete-keys) - (epg-context-set-result context nil) + (setf (epg-context-operation context) 'delete-keys) + (setf (epg-context-result context) nil) (epg--start context (cons (if allow-secret "--delete-secret-key" "--delete-key") @@ -2659,8 +1995,8 @@ If you are unsure, use synchronous version of this function `epg-sign-keys' instead." (declare (obsolete nil "23.1")) - (epg-context-set-operation context 'sign-keys) - (epg-context-set-result context nil) + (setf (epg-context-operation context) 'sign-keys) + (setf (epg-context-result context) nil) (epg--start context (cons (if local "--lsign-key" "--sign-key") @@ -2693,8 +2029,8 @@ `epg-reset' to clear a temporary output file. If you are unsure, use synchronous version of this function `epg-generate-key-from-file' or `epg-generate-key-from-string' instead." - (epg-context-set-operation context 'generate-key) - (epg-context-set-result context nil) + (setf (epg-context-operation context) 'generate-key) + (setf (epg-context-result context) nil) (if (epg-data-file parameters) (epg--start context (list "--batch" "--genkey" "--" (epg-data-file parameters))) ------------------------------------------------------------ revno: 118185 committer: Stefan Monnier branch nick: trunk timestamp: Thu 2014-10-23 09:33:25 -0400 message: * lisp/emacs-lisp/bytecomp.el (byte-compile--use-old-handlers): Change default. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-10-23 08:07:40 +0000 +++ lisp/ChangeLog 2014-10-23 13:33:25 +0000 @@ -1,3 +1,7 @@ +2014-10-23 Stefan Monnier + + * emacs-lisp/bytecomp.el (byte-compile--use-old-handlers): Change default. + 2014-10-23 Leo Liu * progmodes/cfengine.el (cfengine3-defun-full-re): New var. === modified file 'lisp/emacs-lisp/bytecomp.el' --- lisp/emacs-lisp/bytecomp.el 2014-10-23 01:38:59 +0000 +++ lisp/emacs-lisp/bytecomp.el 2014-10-23 13:33:25 +0000 @@ -4072,7 +4072,7 @@ ;; (byte-defop-compiler-1 save-window-excursion) ;Obsolete: now a macro. ;; (byte-defop-compiler-1 with-output-to-temp-buffer) ;Obsolete: now a macro. -(defvar byte-compile--use-old-handlers t +(defvar byte-compile--use-old-handlers nil "If nil, use new byte codes introduced in Emacs-24.4.") (defun byte-compile-catch (form) ------------------------------------------------------------ revno: 118184 committer: martin rudalics branch nick: trunk timestamp: Thu 2014-10-23 15:21:07 +0200 message: Fix some doc-strings in frame.c (Bug#18789). * frame.c (Fset_frame_height, Fset_frame_width, Fset_frame_size) (frame_resize_pixelwise, frame_inhibit_implied_resize): Fix doc-strings (Bug#18789). diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2014-10-23 06:31:48 +0000 +++ src/ChangeLog 2014-10-23 13:21:07 +0000 @@ -1,3 +1,9 @@ +2014-10-23 Martin Rudalics + + * frame.c (Fset_frame_height, Fset_frame_width, Fset_frame_size) + (frame_resize_pixelwise, frame_inhibit_implied_resize): Fix + doc-strings (Bug#18789). + 2014-10-23 Paul Eggert * Makefile.in (ACLOCAL_INPUTS): Omit unnecessary use of 'wildcard'. === modified file 'src/frame.c' --- src/frame.c 2014-10-14 12:45:41 +0000 +++ src/frame.c 2014-10-23 13:21:07 +0000 @@ -2828,11 +2828,15 @@ } DEFUN ("set-frame-height", Fset_frame_height, Sset_frame_height, 2, 4, 0, - doc: /* Specify that the frame FRAME has HEIGHT text lines. + doc: /* Set height of frame FRAME to HEIGHT lines. Optional third arg PRETEND non-nil means that redisplay should use HEIGHT lines but that the idea of the actual height of the frame should -not be changed. Optional fourth argument PIXELWISE non-nil means that -FRAME should be HEIGHT pixels high. */) +not be changed. + +Optional fourth argument PIXELWISE non-nil means that FRAME should be +HEIGHT pixels high. Note: When `frame-resize-pixelwise' is nil, some +window managers may refuse to honor a HEIGHT that is not an integer +multiple of the default frame font height. */) (Lisp_Object frame, Lisp_Object height, Lisp_Object pretend, Lisp_Object pixelwise) { struct frame *f = decode_live_frame (frame); @@ -2850,11 +2854,15 @@ } DEFUN ("set-frame-width", Fset_frame_width, Sset_frame_width, 2, 4, 0, - doc: /* Specify that the frame FRAME has WIDTH columns. + doc: /* Set width of frame FRAME to WIDTH columns. Optional third arg PRETEND non-nil means that redisplay should use WIDTH columns but that the idea of the actual width of the frame should not -be changed. Optional fourth argument PIXELWISE non-nil means that FRAME -should be WIDTH pixels wide. */) +be changed. + +Optional fourth argument PIXELWISE non-nil means that FRAME should be +WIDTH pixels wide. Note: When `frame-resize-pixelwise' is nil, some +window managers may refuse to honor a WIDTH that is not an integer +multiple of the default frame font width. */) (Lisp_Object frame, Lisp_Object width, Lisp_Object pretend, Lisp_Object pixelwise) { struct frame *f = decode_live_frame (frame); @@ -2872,8 +2880,12 @@ } DEFUN ("set-frame-size", Fset_frame_size, Sset_frame_size, 3, 4, 0, - doc: /* Sets size of FRAME to WIDTH by HEIGHT, measured in characters. -Optional argument PIXELWISE non-nil means to measure in pixels. */) + doc: /* Set size of FRAME to WIDTH by HEIGHT, measured in characters. +Optional argument PIXELWISE non-nil means to measure in pixels. Note: +When `frame-resize-pixelwise' is nil, some window managers may refuse to +honor a WIDTH that is not an integer multiple of the default frame font +width or a HEIGHT that is not an integer multiple of the default frame +font height. */) (Lisp_Object frame, Lisp_Object width, Lisp_Object height, Lisp_Object pixelwise) { struct frame *f = decode_live_frame (frame); @@ -4968,12 +4980,13 @@ by one pixel. With some window managers you may have to set this to non-nil in order -to fully maximize frames. To resize your initial frame pixelwise, set -this option to a non-nil value in your init file. */); +to set the size of a frame in pixels, to maximize frames or to make them +fullscreen. To resize your initial frame pixelwise, set this option to +a non-nil value in your init file. */); frame_resize_pixelwise = 0; DEFVAR_BOOL ("frame-inhibit-implied-resize", frame_inhibit_implied_resize, - doc: /* Non-nil means do not resize frame implicitly. + doc: /* Non-nil means do not resize frames implicitly. If this option is nil, setting default font, menubar mode, fringe width, or scroll bar mode of a specific frame may resize the frame in order to preserve the number of columns or lines it displays. If this option is ------------------------------------------------------------ revno: 118183 committer: Leo Liu branch nick: trunk timestamp: Thu 2014-10-23 16:07:40 +0800 message: * lisp/progmodes/cfengine.el (cfengine3-defun-full-re): New var. (cfengine3-create-imenu-index): Use it and use ` ' for separation. (cfengine3-current-defun): New function. (cfengine3-mode): Set add-log-current-defun-function. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-10-23 01:38:59 +0000 +++ lisp/ChangeLog 2014-10-23 08:07:40 +0000 @@ -1,3 +1,10 @@ +2014-10-23 Leo Liu + + * progmodes/cfengine.el (cfengine3-defun-full-re): New var. + (cfengine3-create-imenu-index): Use it and use ` ' for separation. + (cfengine3-current-defun): New function. + (cfengine3-mode): Set add-log-current-defun-function. + 2014-10-23 Stefan Monnier * select.el: Use lexical-binding. === modified file 'lisp/progmodes/cfengine.el' --- lisp/progmodes/cfengine.el 2014-10-11 14:27:47 +0000 +++ lisp/progmodes/cfengine.el 2014-10-23 08:07:40 +0000 @@ -817,6 +817,12 @@ (defconst cfengine3-defuns-regex (regexp-opt cfengine3-defuns t) "Regex to match the CFEngine 3.x defuns.") + (defconst cfengine3-defun-full-re (concat "^\\s-*" cfengine3-defuns-regex + "\\s-+\\(\\(?:\\w\\|\\s_\\)+\\)" ;type + "\\s-+\\(\\(?:\\w\\|\\s_\\)+\\)" ;id + ) + "Regexp matching full defun declaration (excluding argument list).") + (defconst cfengine3-class-selector-regex "\\([[:alnum:]_().&|!:]+\\)::") (defconst cfengine3-category-regex "\\([[:alnum:]_]+\\):") @@ -1299,19 +1305,25 @@ ("::" . ?∷))) (defun cfengine3-create-imenu-index () - "A function for `imenu-create-index-function'." + "A function for `imenu-create-index-function'. +Note: defun name is separated by space such as `body +package_method opencsw' and imenu will replace spaces according +to `imenu-space-replacement' (which see)." (goto-char (point-min)) - (let ((re (concat "^\\s-*" cfengine3-defuns-regex - "\\s-+\\(\\(?:\\w\\|\\s_\\)+\\)" ;type - "\\s-+\\(\\(?:\\w\\|\\s_\\)+\\)" ;id - )) - (defuns ())) - (while (re-search-forward re nil t) - (push (cons (mapconcat #'match-string '(1 2 3) ".") + (let ((defuns ())) + (while (re-search-forward cfengine3-defun-full-re nil t) + (push (cons (mapconcat #'match-string '(1 2 3) " ") (copy-marker (match-beginning 3))) defuns)) (nreverse defuns))) +(defun cfengine3-current-defun () + "A function for `add-log-current-defun-function'." + (end-of-line) + (beginning-of-defun) + (and (looking-at cfengine3-defun-full-re) + (mapconcat #'match-string '(1 2 3) " "))) + ;;;###autoload (define-derived-mode cfengine3-mode prog-mode "CFE3" "Major mode for editing CFEngine3 input. @@ -1347,7 +1359,8 @@ (setq-local beginning-of-defun-function #'cfengine3-beginning-of-defun) (setq-local end-of-defun-function #'cfengine3-end-of-defun) - (setq-local imenu-create-index-function #'cfengine3-create-imenu-index)) + (setq-local imenu-create-index-function #'cfengine3-create-imenu-index) + (setq-local add-log-current-defun-function #'cfengine3-current-defun)) ;;;###autoload (define-derived-mode cfengine2-mode prog-mode "CFE2" ------------------------------------------------------------ revno: 118182 committer: Paul Eggert branch nick: trunk timestamp: Wed 2014-10-22 23:31:48 -0700 message: * Makefile.in (ACLOCAL_INPUTS): Omit unnecessary use of 'wildcard'. diff: === modified file 'ChangeLog' --- ChangeLog 2014-10-23 03:32:21 +0000 +++ ChangeLog 2014-10-23 06:31:48 +0000 @@ -1,11 +1,12 @@ 2014-10-23 Paul Eggert + * Makefile.in (ACLOCAL_INPUTS): Omit unnecessary use of 'wildcard'. + Fix race in 'make info/dir', and speed it up. * Makefile.in (AWK, srcdir_doc_info_dir_inputs, info_dir_inputs): New macros. (clean): Remove info-dir.*. (info_dir_deps): Depend on make-info-dir too. - Fix bug with wildcards that weren't expanded. (${srcdir}/info/dir): Make sure info directory exists. Don't call pwd; just redirect make-info-dir's stdout to temp file. * build-aux/make-info-dir: Send output to stdout. === modified file 'Makefile.in' --- Makefile.in 2014-10-23 03:32:21 +0000 +++ Makefile.in 2014-10-23 06:31:48 +0000 @@ -417,7 +417,7 @@ cd ${srcdir} && ${AUTOCONF} ACLOCAL_PATH = @ACLOCAL_PATH@ -ACLOCAL_INPUTS = $(srcdir)/configure.ac $(wildcard $(srcdir)/m4/*.m4) +ACLOCAL_INPUTS = $(srcdir)/configure.ac $(srcdir)/m4/*.m4 $(srcdir)/aclocal.m4: $(ACLOCAL_INPUTS) cd $(srcdir) && ACLOCAL_PATH='$(ACLOCAL_PATH)' $(ACLOCAL) -I m4 === modified file 'src/ChangeLog' --- src/ChangeLog 2014-10-22 16:09:57 +0000 +++ src/ChangeLog 2014-10-23 06:31:48 +0000 @@ -1,3 +1,7 @@ +2014-10-23 Paul Eggert + + * Makefile.in (ACLOCAL_INPUTS): Omit unnecessary use of 'wildcard'. + 2014-10-22 Eli Zaretskii Optimize redisplay of simple bracketed text. === modified file 'src/Makefile.in' --- src/Makefile.in 2014-10-12 08:35:50 +0000 +++ src/Makefile.in 2014-10-23 06:31:48 +0000 @@ -535,7 +535,7 @@ FORCE: .PHONY: FORCE -ACLOCAL_INPUTS = $(top_srcdir)/configure.ac $(wildcard $(top_srcdir)/m4/*.m4) +ACLOCAL_INPUTS = $(top_srcdir)/configure.ac $(top_srcdir)/m4/*.m4 AUTOCONF_INPUTS = $(top_srcdir)/configure.ac $(top_srcdir)/aclocal.m4 $(top_srcdir)/aclocal.m4: $(ACLOCAL_INPUTS) $(top_srcdir)/configure config.in: $(AUTOCONF_INPUTS) ------------------------------------------------------------ revno: 118181 committer: Paul Eggert branch nick: trunk timestamp: Wed 2014-10-22 20:32:21 -0700 message: Fix race in 'make info/dir', and speed it up. * Makefile.in (AWK, srcdir_doc_info_dir_inputs, info_dir_inputs): New macros. (clean): Remove info-dir.*. (info_dir_deps): Depend on make-info-dir too. Fix bug with wildcards that weren't expanded. (${srcdir}/info/dir): Make sure info directory exists. Don't call pwd; just redirect make-info-dir's stdout to temp file. * build-aux/make-info-dir: Send output to stdout. Take input file names from args. Fix a "FIXME inefficient looping" by using awk's associative arrays. Basically, this rewrites the script from scratch, and speeds up 'make info/dir' from 2.6s to 0.07s on my platform. diff: === modified file 'ChangeLog' --- ChangeLog 2014-10-20 19:59:41 +0000 +++ ChangeLog 2014-10-23 03:32:21 +0000 @@ -1,3 +1,19 @@ +2014-10-23 Paul Eggert + + Fix race in 'make info/dir', and speed it up. + * Makefile.in (AWK, srcdir_doc_info_dir_inputs, info_dir_inputs): + New macros. + (clean): Remove info-dir.*. + (info_dir_deps): Depend on make-info-dir too. + Fix bug with wildcards that weren't expanded. + (${srcdir}/info/dir): Make sure info directory exists. + Don't call pwd; just redirect make-info-dir's stdout to temp file. + * build-aux/make-info-dir: Send output to stdout. + Take input file names from args. + Fix a "FIXME inefficient looping" by using awk's associative arrays. + Basically, this rewrites the script from scratch, and speeds up + 'make info/dir' from 2.6s to 0.07s on my platform. + 2014-10-20 Glenn Morris * Merge in all changes up to 24.4 release. === modified file 'Makefile.in' --- Makefile.in 2014-08-28 02:02:18 +0000 +++ Makefile.in 2014-10-23 03:32:21 +0000 @@ -80,6 +80,7 @@ AUTOMAKE = @AUTOMAKE@ AUTOHEADER = @AUTOHEADER@ ACLOCAL = @ACLOCAL@ +AWK = @AWK@ EXEEXT=@EXEEXT@ @@ -817,6 +818,7 @@ [ ! -d $$dir ] || $(MAKE) -C $$dir clean; \ done -rm -f etc/emacs.tmpdesktop etc/emacs.tmpappdata + -rm -rf info-dir.* ### `bootclean' ### Delete all files that need to be remade for a clean bootstrap. @@ -935,13 +937,19 @@ info-dir: ${srcdir}/info/dir -## Not strictly necessary, but speeds things up a bit by stopping -## the info-dir rule from running when not needed. ## Hopefully doc/misc/*.texi is not too long for some systems? -info_dir_deps = ${srcdir}/build-aux/dir_top \ - ${srcdir}/doc/emacs/emacs.texi \ - ${srcdir}/doc/lispintro/emacs-lisp-intro.texi \ - ${srcdir}/doc/lispref/elisp.texi ${srcdir}/doc/misc/*.texi +srcdir_doc_info_dir_inputs = \ + ${srcdir}/doc/emacs/emacs.texi \ + ${srcdir}/doc/lispintro/emacs-lisp-intro.texi \ + ${srcdir}/doc/lispref/elisp.texi \ + $(sort $(wildcard ${srcdir}/doc/misc/*.texi)) +info_dir_inputs = \ + ../build-aux/dir_top \ + $(subst ${srcdir}/doc/,,${srcdir_doc_info_dir_inputs}) +info_dir_deps = \ + ${srcdir}/build-aux/make-info-dir \ + ${srcdir}/build-aux/dir_top \ + ${srcdir_doc_info_dir_inputs} ## It would be much simpler if info/dir was only created in the ## installation location by the install-info rule, but we also @@ -950,10 +958,12 @@ ## but then we would need to depend on info-real, which would ## slow down parallelization. ${srcdir}/info/dir: ${info_dir_deps} + ${MKDIR_P} ${srcdir}/info tempfile=info-dir.$$$$; \ rm -f $${tempfile}; \ - thisdir=`pwd`; \ - (cd ${srcdir} && ./build-aux/make-info-dir $${thisdir}/$${tempfile}); \ + (cd ${srcdir}/doc && \ + AWK='${AWK}' ../build-aux/make-info-dir ${info_dir_inputs} \ + ) >$$tempfile && \ ${srcdir}/build-aux/move-if-change $${tempfile} ${srcdir}/info/dir INSTALL_DVI = install-emacs-dvi install-lispref-dvi \ === modified file 'build-aux/make-info-dir' --- build-aux/make-info-dir 2014-02-10 01:34:22 +0000 +++ build-aux/make-info-dir 2014-10-23 03:32:21 +0000 @@ -31,76 +31,44 @@ ## installation directory. It does not handle info/dir being present ## but missing some entries. -### Code: - -if test $# -ne 1; then - echo "Specify destination file" - exit 1 -fi - -outfile=$1 - -echo "Creating $outfile..." - -if test -f "$outfile"; then - echo "$outfile already present" - exit 1 -fi - ## Header contains non-printing characters, so this is more -## reliable than using echo. -basefile=build-aux/dir_top - -if test ! -f "$basefile"; then - echo "$basefile not found" - exit 1 -fi - - -cp $basefile $outfile - - -## FIXME inefficient looping. -## What we should do is loop once over files, collecting topic and -## direntry information for each. Then loop over topics and write -## out the results. But that seems to require associative arrays, -## and I do not know how to do that with portable sh. -## Could use Emacs instead of sh, but till now info generation does -## not require Emacs to have been built. -for topic in "Texinfo documentation system" "Emacs" "Emacs lisp" \ - "Emacs editing modes" "Emacs network features" "Emacs misc features" \ - "Emacs lisp libraries"; do - - cat - <> $outfile - -$topic -EOF - ## Bit faster than doc/*/*.texi. - for file in doc/emacs/emacs.texi doc/lispintro/emacs-lisp-intro.texi \ - doc/lispref/elisp.texi doc/misc/*.texi; do - - ## FIXME do not ignore w32 if OS is w32. - case $file in - *-xtra.texi|*efaq-w32.texi|*doclicense.texi) continue ;; - esac - - dircat=`sed -n -e 's/@value{emacsname}/Emacs/' -e 's/^@dircategory //p' $file` - - ## TODO warn about unknown topics. - ## (check-info in top-level Makefile does that.) - test "$dircat" = "$topic" || continue - - - sed -n -e 's/@value{emacsname}/Emacs/' \ - -e 's/@acronym{\([A-Z]*\)}/\1/' \ - -e '/^@direntry/,/^@end direntry/ s/^\([^@]\)/\1/p' \ - $file >> $outfile - - done -done - -echo "Created $outfile" - -exit 0 - -### make-info-dir ends here +## reliable than using awk. +cat <"${1?}" || exit +shift + +exec "${AWK-awk}" ' + function detexinfo() { + gsub(/@value{emacsname}/, "Emacs") + gsub(/@[^{]*\{/, "") + gsub(/}/, "") + } + BEGIN { + ntopics = 0 + topic[ntopics++] = "Texinfo documentation system" + topic[ntopics++] = "Emacs" + topic[ntopics++] = "Emacs lisp" + topic[ntopics++] = "Emacs editing modes" + topic[ntopics++] = "Emacs network features" + topic[ntopics++] = "Emacs misc features" + topic[ntopics++] = "Emacs lisp libraries" + topic[ntopics] = "Unknown category" + } + /^@dircategory / { + sub(/^@dircategory /, "") + detexinfo() + for (dircat = 0; dircat < ntopics && topic[dircat] != $0; dircat++) + continue; + } + /^@direntry/, /^@end direntry/ { + # FIXME do not ignore w32 if OS is w32. + if ($0 !~ /^@/ && $0 !~ /w32/) { + detexinfo() + data[dircat] = data[dircat] $0 "\n" + } + } + END { + for (dircat = 0; dircat <= ntopics; dircat++) + if (data[dircat]) + printf "\n%s\n%s", topic[dircat], data[dircat] + } +' "${@?}" ------------------------------------------------------------ revno: 118180 fixes bug: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=18791 committer: Stefan Monnier branch nick: trunk timestamp: Wed 2014-10-22 21:38:59 -0400 message: * lisp/select.el: Use lexical-binding. (gui-set-selection): Provide an implementation for non-GUI frames. * lisp/term/x-win.el: Use lexical-binding. (x-clipboard-yank): Fix up missed renamings. * lisp/term/w32-win.el (libgif-version, libjpeg-version): Silence compiler. (w32--set-selection): Fix up var names. * lisp/term/pc-win.el: Use lexical-binding. (w16-selection-exists-p): Silence compiler warning. (w16-selection-owner-p): Fix up missed renamings. * lisp/emacs-lisp/bytecomp.el (byte-compile-form): Remove left-over debug. * lisp/frame.el (frame-notice-user-settings): Fix excessive quoting. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-10-22 13:30:16 +0000 +++ lisp/ChangeLog 2014-10-23 01:38:59 +0000 @@ -1,3 +1,20 @@ +2014-10-23 Stefan Monnier + + * select.el: Use lexical-binding. + (gui-set-selection): Provide an implementation for non-GUI frames + (bug#18791). + * term/x-win.el: Use lexical-binding. + (x-clipboard-yank): Fix up missed renamings. + * term/w32-win.el (libgif-version, libjpeg-version): Silence compiler. + (w32--set-selection): Fix up var names. + * term/pc-win.el: Use lexical-binding. + (w16-selection-exists-p): Silence compiler warning. + (w16-selection-owner-p): Fix up missed renamings. + + * emacs-lisp/bytecomp.el (byte-compile-form): Remove left-over debug. + + * frame.el (frame-notice-user-settings): Fix excessive quoting. + 2014-10-22 Tassilo Horn * doc-view.el (doc-view-open-text): View the document's plain text === modified file 'lisp/emacs-lisp/bytecomp.el' --- lisp/emacs-lisp/bytecomp.el 2014-10-20 19:59:41 +0000 +++ lisp/emacs-lisp/bytecomp.el 2014-10-23 01:38:59 +0000 @@ -2963,11 +2963,9 @@ interactive-only)) (t ".")))) (if (eq (car-safe (symbol-function (car form))) 'macro) - (progn - (debug) - (byte-compile-log-warning - (format "Forgot to expand macro %s in %S" (car form) form) - nil :error))) + (byte-compile-log-warning + (format "Forgot to expand macro %s in %S" (car form) form) + nil :error)) (if (and handler ;; Make sure that function exists. (and (functionp handler) === modified file 'lisp/frame.el' --- lisp/frame.el 2014-10-21 15:27:18 +0000 +++ lisp/frame.el 2014-10-23 01:38:59 +0000 @@ -305,7 +305,7 @@ frame-initial-frame-tool-bar-height))) (t (+ top frame-initial-frame-tool-bar-height))))) (modify-frame-parameters - frame-initial-frame '((top . adjusted-top)))))) + frame-initial-frame `((top . ,adjusted-top)))))) (tool-bar-mode -1)))) ;; The initial frame we create above always has a minibuffer. === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2014-10-21 01:17:06 +0000 +++ lisp/gnus/ChangeLog 2014-10-23 01:38:59 +0000 @@ -616,7 +616,7 @@ * gnus-icalendar.el (gnus-icalendar-event:org-timestamp): Fix org-timestamp for events ending at midnight. -2013-11-21 Ivan Shmakov (tiny change) +2013-11-21 Ivan Shmakov * nndoc.el (nndoc-type-alist, nndoc-debbugs-db-type-p): Support debbugs .log files. === modified file 'lisp/org/ChangeLog' --- lisp/org/ChangeLog 2014-10-21 01:17:06 +0000 +++ lisp/org/ChangeLog 2014-10-23 01:38:59 +0000 @@ -6680,7 +6680,7 @@ (org-mew-open-by-message-id, org-mew-search, org-mew-capture) (org-mew-capture-guess-selection-keys): New functions. -2013-11-12 Trevor Murphy (tiny change) +2013-11-12 Trevor Murphy * org.el (org-get-compact-tod): Always pad minutes to two places. === modified file 'lisp/select.el' --- lisp/select.el 2014-10-21 15:27:18 +0000 +++ lisp/select.el 2014-10-23 01:38:59 +0000 @@ -1,4 +1,4 @@ -;;; select.el --- lisp portion of standard selection support +;;; select.el --- lisp portion of standard selection support -*- lexical-binding:t -*- ;; Copyright (C) 1993-1994, 2001-2014 Free Software Foundation, Inc. @@ -255,7 +255,7 @@ \(Those are literal upper-case symbol names, since that's what X expects.) TARGET-TYPE is the type of data desired, typically `STRING'.") -(gui-method-declare gui-set-selection nil +(gui-method-declare gui-set-selection #'ignore "Method to assert a selection of type SELECTION and value VALUE. SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'. If VALUE is nil and we own the selection SELECTION, disown it instead. === modified file 'lisp/term/pc-win.el' --- lisp/term/pc-win.el 2014-10-21 15:27:18 +0000 +++ lisp/term/pc-win.el 2014-10-23 01:38:59 +0000 @@ -1,4 +1,4 @@ -;;; pc-win.el --- setup support for `PC windows' (whatever that is) +;;; pc-win.el --- setup support for `PC windows' (whatever that is) -*- lexical-binding:t -*- ;; Copyright (C) 1994, 1996-1997, 1999, 2001-2014 Free Software ;; Foundation, Inc. @@ -45,20 +45,20 @@ (declare-function w16-get-clipboard-data "w16select.c") (declare-function msdos-setup-keyboard "internal" (frame)) -;;; This was copied from etc/rgb.txt, except that some values were changed -;;; a bit to make them consistent with DOS console colors, and the RGB -;;; values were scaled up to 16 bits, as `tty-define-color' requires. -;;; -;;; The mapping between the 16 standard EGA/VGA colors and X color names -;;; was done by running a Unix version of Emacs inside an X client and a -;;; DJGPP-compiled Emacs on the same PC. The names of X colors used to -;;; define the pixel values are shown as comments to each color below. -;;; -;;; If you want to change the RGB values, keep in mind that various pieces -;;; of Emacs think that a color whose RGB values add up to less than 0.6 of -;;; the values for WHITE (i.e. less than 117963) are ``dark'', otherwise the -;;; color is ``light''; see `frame-set-background-mode' in lisp/faces.el for -;;; an example. +;; This was copied from etc/rgb.txt, except that some values were changed +;; a bit to make them consistent with DOS console colors, and the RGB +;; values were scaled up to 16 bits, as `tty-define-color' requires. +;;; +;; The mapping between the 16 standard EGA/VGA colors and X color names +;; was done by running a Unix version of Emacs inside an X client and a +;; DJGPP-compiled Emacs on the same PC. The names of X colors used to +;; define the pixel values are shown as comments to each color below. +;;; +;; If you want to change the RGB values, keep in mind that various pieces +;; of Emacs think that a color whose RGB values add up to less than 0.6 of +;; the values for WHITE (i.e. less than 117963) are ``dark'', otherwise the +;; color is ``light''; see `frame-set-background-mode' in lisp/faces.el for +;; an example. (defvar msdos-color-values '(("black" 0 0 0 0) ("blue" 1 0 0 52480) ; MediumBlue @@ -226,15 +226,17 @@ (with-demoted-errors "w16-get-clipboard-data:%s" (w16-get-clipboard-data))) +(declare-function w16-selection-exists-p "w16select.c") ;; gui-selection-owner-p is used in simple.el. (gui-method-define gui-selection-exists-p pc #'w16-selection-exists-p) (gui-method-define gui-selection-owner-p pc #'w16-selection-owner-p) + (defun w16-selection-owner-p (_selection) - ;; FIXME: Other systems don't obey gui-select-enable-clipboard here. - (if gui-select-enable-clipboard + ;; FIXME: Other systems don't obey select-enable-clipboard here. + (if select-enable-clipboard (let ((text ;; Don't die if w16-get-clipboard-data signals an error. - (ignore-errors + (with-demoted-errors "w16-get-clipboard-data: %S" (w16-get-clipboard-data)))) ;; We consider ourselves the owner of the selection ;; if it does not exist, or exists and compares @@ -242,9 +244,7 @@ ;; Windows clipboard. (cond ((not text) t) - ((or (eq text gui-last-selected-text) - (string= text gui-last-selected-text)) - text) + ((equal text gui--last-selected-text-clipboard) text) (t nil))))) ;; gui-set-selection is used in gui-set-selection. === modified file 'lisp/term/w32-win.el' --- lisp/term/w32-win.el 2014-10-21 15:27:18 +0000 +++ lisp/term/w32-win.el 2014-10-23 01:38:59 +0000 @@ -211,6 +211,8 @@ (defvar dynamic-library-alist) (defvar libpng-version) ; image.c #ifdef HAVE_NTGUI +(defvar libgif-version) +(defvar libjpeg-version) ;;; Set default known names for external libraries (setq dynamic-library-alist @@ -381,12 +383,13 @@ (declare-function w32-set-clipboard-data "w32select.c" (string &optional ignored)) (declare-function w32-get-clipboard-data "w32select.c") +(declare-function w32-selection-exists-p "w32select.c") ;;; Fix interface to (X-specific) mouse.el (defun w32--set-selection (type value) (if (eq type 'CLIPBOARD) - (w32-set-clipboard-data text) - (put 'x-selections (or type 'PRIMARY) data))) + (w32-set-clipboard-data value) + (put 'x-selections (or type 'PRIMARY) value))) (defun w32--get-selection (&optional type data-type) (if (and (eq type 'CLIPBOARD) === modified file 'lisp/term/x-win.el' --- lisp/term/x-win.el 2014-10-21 15:27:18 +0000 +++ lisp/term/x-win.el 2014-10-23 01:38:59 +0000 @@ -1,4 +1,4 @@ -;;; x-win.el --- parse relevant switches and set up for X -*-coding: iso-2022-7bit;-*- +;;; x-win.el --- parse relevant switches and set up for X -*-coding: iso-2022-7bit; lexical-binding:t -*- ;; Copyright (C) 1993-1994, 2001-2014 Free Software Foundation, Inc. @@ -1163,8 +1163,8 @@ "Insert the clipboard contents, or the last stretch of killed text." (declare (obsolete clipboard-yank "25.1")) (interactive "*") - (let ((clipboard-text (x-selection-value-internal 'CLIPBOARD)) - (x-select-enable-clipboard t)) + (let ((clipboard-text (gui--selection-value-internal 'CLIPBOARD)) + (select-enable-clipboard t)) (if (and clipboard-text (> (length clipboard-text) 0)) (kill-new clipboard-text)) (yank))) ------------------------------------------------------------ revno: 118179 fixes bug: http://debbugs.gnu.org/18778 committer: Eli Zaretskii branch nick: trunk timestamp: Wed 2014-10-22 19:09:57 +0300 message: Fix bug #18778 with slow redisplay of bracketed L2R text with long lines. src/bidi.c (bidi_cache_reset_to): New function. (bidi_cache_reset): Call it. (bidi_init_it, bidi_line_init): Initialize the bracket_pairing_pos member to -1. (bidi_resolve_explicit): Reset bracket_pairing_pos and bracket_enclosed_type only if bracket_pairing_pos's value is not ZV. (MAX_BPA_STACK): Make sure the value is signed. (PUSH_BPA_STACK): If the BPA stack overflows, don't bail out, but stop pushing values onto the stack. (bidi_find_bracket_pairs): If the bracketed text is only on the base embedding level, remove all the states cached by this function from the cache, and return zero, so that the brackets in this segment of text are processed as normal neutrals. (bidi_resolve_brackets): Detect the brackets that are to be processed as neutrals, and don't call bidi_find_bracket_pairs on them. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2014-10-21 15:27:18 +0000 +++ src/ChangeLog 2014-10-22 16:09:57 +0000 @@ -1,3 +1,24 @@ +2014-10-22 Eli Zaretskii + + Optimize redisplay of simple bracketed text. + * bidi.c (bidi_cache_reset_to): New function. + (bidi_cache_reset): Call it. + (bidi_init_it, bidi_line_init): Initialize the bracket_pairing_pos + member to -1. + (bidi_resolve_explicit): Reset bracket_pairing_pos and + bracket_enclosed_type only if bracket_pairing_pos's value is not + ZV. + (MAX_BPA_STACK): Make sure the value is signed. + (PUSH_BPA_STACK): If the BPA stack overflows, don't bail out, but + stop pushing values onto the stack. + (bidi_find_bracket_pairs): If the bracketed text is only on the + base embedding level, remove all the states cached by this + function from the cache, and return zero, so that the brackets in + this segment of text are processed as normal neutrals. + (bidi_resolve_brackets): Detect the brackets that are to be + processed as neutrals, and don't call bidi_find_bracket_pairs on + them. (Bug#18778) + 2014-10-21 Stefan Monnier * w32select.c (Fw32_selection_exists_p): Rename from === modified file 'src/bidi.c' --- src/bidi.c 2014-10-20 16:00:35 +0000 +++ src/bidi.c 2014-10-22 16:09:57 +0000 @@ -565,6 +565,16 @@ + sizeof (bidi_cache_last_idx)) }; +/* Effectively remove the cached states beyond the Nth state from the + part of the cache relevant to iteration of the current object + (buffer or string). */ +static void +bidi_cache_reset_to (int n) +{ + bidi_cache_idx = bidi_cache_start + n; + bidi_cache_last_idx = n - 1; +} + /* Reset the cache state to the empty state. We only reset the part of the cache relevant to iteration of the current object. Previous objects, which are pushed on the display iterator's stack, are left @@ -574,8 +584,7 @@ static void bidi_cache_reset (void) { - bidi_cache_idx = bidi_cache_start; - bidi_cache_last_idx = -1; + bidi_cache_reset_to (0); } /* Shrink the cache to its minimal size. Called when we init the bidi @@ -1076,6 +1085,7 @@ bidi_it->prev_for_neutral.charpos = -1; bidi_it->prev_for_neutral.type = bidi_it->prev_for_neutral.orig_type = UNKNOWN_BT; + bidi_it->bracket_pairing_pos = -1; bidi_it->sos = L2R; /* FIXME: should it be user-selectable? */ bidi_it->disp_pos = -1; /* invalid/unknown */ bidi_it->disp_prop = 0; @@ -1105,6 +1115,7 @@ bidi_it->next_en_type = UNKNOWN_BT; bidi_it->next_for_ws.charpos = -1; bidi_it->next_for_ws.type = UNKNOWN_BT; + bidi_it->bracket_pairing_pos = -1; bidi_set_sos_type (bidi_it, (bidi_it->paragraph_dir == R2L ? 1 : 0), bidi_it->level_stack[0].level); /* X10 */ @@ -1758,7 +1769,14 @@ /* If we overstepped the characters used for resolving neutrals and whitespace, invalidate their info in the iterator. */ if (bidi_it->charpos >= bidi_it->next_for_neutral.charpos) - bidi_it->next_for_neutral.type = UNKNOWN_BT; + { + bidi_it->next_for_neutral.type = UNKNOWN_BT; + /* If needed, reset the "magical" value of pairing bracket + position, so that bidi_resolve_brackets will resume + resolution of brackets according to BPA. */ + if (bidi_it->bracket_pairing_pos == ZV) + bidi_it->bracket_pairing_pos = -1; + } if (bidi_it->next_en_pos >= 0 && bidi_it->charpos >= bidi_it->next_en_pos) { @@ -1766,9 +1784,14 @@ bidi_it->next_en_type = UNKNOWN_BT; } - /* Reset the bracket resolution info. */ - bidi_it->bracket_pairing_pos = -1; - bidi_it->bracket_enclosed_type = UNKNOWN_BT; + /* Reset the bracket resolution info, unless we previously decided + (in bidi_find_bracket_pairs) that brackets in this level run + should be resolved as neutrals. */ + if (bidi_it->bracket_pairing_pos != ZV) + { + bidi_it->bracket_pairing_pos = -1; + bidi_it->bracket_enclosed_type = UNKNOWN_BT; + } /* If reseat()'ed, don't advance, so as to start iteration from the position where we were reseated. bidi_it->bytepos can be less @@ -2336,7 +2359,7 @@ /* With MAX_ALLOCA of 16KB, this should allow at least 1K slots in the BPA stack, which should be more than enough for actual bidi text. */ -#define MAX_BPA_STACK (max (MAX_ALLOCA / sizeof (bpa_stack_entry), 1)) +#define MAX_BPA_STACK ((int)max (MAX_ALLOCA / sizeof (bpa_stack_entry), 1)) /* UAX#9 says to match opening brackets with the matching closing brackets or their canonical equivalents. As of Unicode 7.0, there @@ -2383,17 +2406,15 @@ #define PUSH_BPA_STACK \ do { \ int ch; \ - bpa_sp++; \ - if (bpa_sp >= MAX_BPA_STACK) \ + if (bpa_sp < MAX_BPA_STACK - 1) \ { \ - bpa_sp = MAX_BPA_STACK - 1; \ - goto bpa_give_up; \ + bpa_sp++; \ + ch = CANONICAL_EQU (bidi_it->ch); \ + bpa_stack[bpa_sp].close_bracket_char = bidi_mirror_char (ch); \ + bpa_stack[bpa_sp].open_bracket_idx = bidi_cache_last_idx; \ + bpa_stack[bpa_sp].flags = 0; \ + STORE_BRACKET_CHARPOS; \ } \ - ch = CANONICAL_EQU (bidi_it->ch); \ - bpa_stack[bpa_sp].close_bracket_char = bidi_mirror_char (ch); \ - bpa_stack[bpa_sp].open_bracket_idx = bidi_cache_last_idx; \ - bpa_stack[bpa_sp].flags = 0; \ - STORE_BRACKET_CHARPOS; \ } while (0) @@ -2422,9 +2443,13 @@ bpa_stack_entry bpa_stack[MAX_BPA_STACK]; int bpa_sp = -1; struct bidi_it saved_it; + int base_level = bidi_it->level_stack[0].level; int embedding_level = bidi_it->level_stack[bidi_it->stack_idx].level; + int maxlevel = embedding_level; bidi_type_t embedding_type = (embedding_level & 1) ? STRONG_R : STRONG_L; struct bidi_it tem_it; + bool l2r_seen = false, r2l_seen = false; + ptrdiff_t pairing_pos; eassert (MAX_BPA_STACK >= 100); bidi_copy_it (&saved_it, bidi_it); @@ -2438,6 +2463,8 @@ int old_sidx, new_sidx; int current_level = bidi_it->level_stack[bidi_it->stack_idx].level; + if (maxlevel < current_level) + maxlevel = current_level; /* Mark every opening bracket character we've traversed by putting its own position into bracket_pairing_pos. This is examined in bidi_resolve_brackets to distinguish @@ -2503,6 +2530,7 @@ flag = ((embedding_level & 1) == 0 ? FLAG_EMBEDDING_INSIDE : FLAG_OPPOSITE_INSIDE); + l2r_seen = true; break; case STRONG_R: case WEAK_EN: @@ -2510,6 +2538,7 @@ flag = ((embedding_level & 1) == 1 ? FLAG_EMBEDDING_INSIDE : FLAG_OPPOSITE_INSIDE); + r2l_seen = true; break; default: break; @@ -2532,6 +2561,8 @@ while (bidi_it->level_stack[bidi_it->stack_idx].level > current_level) { + if (maxlevel < bidi_it->level_stack[bidi_it->stack_idx].level) + maxlevel = bidi_it->level_stack[bidi_it->stack_idx].level; bidi_cache_iterator_state (bidi_it, type == NEUTRAL_B, 0); type = bidi_resolve_weak (bidi_it); } @@ -2540,11 +2571,11 @@ || (bidi_it->level_stack[bidi_it->stack_idx].level != current_level)) { - bpa_give_up: /* We've marched all the way to the end of this isolating run sequence, and didn't find matching closing brackets for some opening brackets. Leave their type unchanged. */ + pairing_pos = bidi_it->charpos; break; } if (bidi_it->type_after_wn == NEUTRAL_ON) /* Unicode 8.0 correction */ @@ -2557,6 +2588,52 @@ resolution members set as determined by the above loop. */ type = bidi_cache_find (saved_it.charpos, 0, bidi_it); eassert (type == NEUTRAL_ON); + + /* The following is an optimization for bracketed text that has + only one level which is equal to the paragraph's base + embedding level. That is, only L2R and weak/neutral + characters in a L2R paragraph, or only R2L and weak/neutral + characters in a R2L paragraph. Such brackets can be resolved + by bidi_resolve_neutral, which has a further shortcut for + this case. So we pretend we did not resolve the brackets in + this case, set up next_for_neutral for the entire bracketed + text, and reset the cache to the character before the opening + bracket. The upshot is to allow bidi_move_to_visually_next + reset the cache when it returns this opening bracket, thus + cutting significantly on the size of the cache, which is + important with long lines, especially if word-wrap is non-nil + (which requires the display engine to copy the cache back and + forth many times). */ + if (maxlevel == base_level + && ((base_level == 0 && !r2l_seen) + || (base_level == 1 && !l2r_seen))) + { + if (retval) + pairing_pos = bidi_it->bracket_pairing_pos; + + /* This special value (which cannot possibly happen when + brackets are resolved, since there's no character at ZV) + will be noticed by bidi_resolve_explicit, and will be + copied to the following iterator states, instead of being + reset to -1. */ + bidi_it->bracket_pairing_pos = ZV; + /* This type value will be used for resolving the outermost + closing bracket in bidi_resolve_brackets. */ + bidi_it->bracket_enclosed_type = embedding_type; + /* bidi_cache_last_idx is set to the index of the current + state, because we just called bidi_cache_find above. + Force the cache to "forget" all the cached states + starting from the one corresponding to the outermost + opening bracket, which is what the current state + describes. */ + bidi_cache_reset_to (bidi_cache_last_idx); + /* Set up the next_for_neutral member, to help + bidi_resolve_neutral. */ + bidi_it->next_for_neutral.type = embedding_type; + bidi_it->next_for_neutral.charpos = pairing_pos; + /* Pretend we didn't resolve this bracket. */ + retval = false; + } } return retval; @@ -2614,10 +2691,27 @@ if (type == UNKNOWN_BT) { type = bidi_resolve_weak (bidi_it); - if (type == NEUTRAL_ON && bidi_find_bracket_pairs (bidi_it)) - resolve_bracket = true; + if (type == NEUTRAL_ON) + { + /* bracket_pairing_pos == ZV means this bracket does not + need to be resolved as a bracket, but as a neutral, see + the optimization trick we play near the end of + bidi_find_bracket_pairs. */ + if (bidi_it->bracket_pairing_pos == ZV) + { + /* If this is the outermost closing bracket of a run of + characters in which we decided to resolve brackets as + neutrals, use the embedding level's type, recorded in + bracket_enclosed_type, to resolve the bracket. */ + if (bidi_it->next_for_neutral.charpos == bidi_it->charpos + && bidi_paired_bracket_type (bidi_it->ch) == BIDI_BRACKET_CLOSE) + type = bidi_it->bracket_enclosed_type; + } + else if (bidi_find_bracket_pairs (bidi_it)) + resolve_bracket = true; + } } - else + else if (bidi_it->bracket_pairing_pos != ZV) { eassert (bidi_it->resolved_level == -1); /* If the cached state shows an increase of embedding level due ------------------------------------------------------------ revno: 118178 committer: Tassilo Horn branch nick: build timestamp: Wed 2014-10-22 15:30:16 +0200 message: Improve viewing plain text contents of document * doc/emacs/misc.texi (Document View): Adapt to latest doc-view changes wrt viewing the document's plain text contents. * lisp/doc-view.el (doc-view-open-text): View the document's plain text in the current buffer instead of a new one. (doc-view-toggle-display): Handle the case where the current buffer contains the plain text contents of the document. (doc-view-initiate-display): Don't switch to fallback mode if the user wants to view the doc's plain text. (doc-view-set-doc-type): Use assoc-string instead of assoc-ignore-case. diff: === modified file 'doc/emacs/ChangeLog' --- doc/emacs/ChangeLog 2014-10-21 01:17:06 +0000 +++ doc/emacs/ChangeLog 2014-10-22 13:30:16 +0000 @@ -1,3 +1,8 @@ +2014-10-22 Tassilo Horn + + * misc.texi (Document View): Adapt to latest doc-view changes wrt + viewing the document's plain text contents. + 2014-10-20 Glenn Morris * Merge in all changes up to 24.4 release. === modified file 'doc/emacs/misc.texi' --- doc/emacs/misc.texi 2014-10-05 17:19:23 +0000 +++ doc/emacs/misc.texi 2014-10-22 13:30:16 +0000 @@ -266,9 +266,10 @@ OpenDocument, and Microsoft Office documents. It provides features such as slicing, zooming, and searching inside documents. It works by converting the document to a set of images using the @command{gs} -(GhostScript) command and other external tools @footnote{@code{gs} is -a hard requirement. For DVI files, @code{dvipdf} or @code{dvipdfm} is -needed. For OpenDocument and Microsoft Office documents, the +(GhostScript) or @command{mudraw}/@command{pdfdraw} (MuPDF) commands +and other external tools @footnote{For PostScript files, GhostScript +is a hard requirement. For DVI files, @code{dvipdf} or @code{dvipdfm} +is needed. For OpenDocument and Microsoft Office documents, the @code{unoconv} tool is needed.}, and displaying those images. @findex doc-view-toggle-display @@ -287,6 +288,17 @@ (@code{doc-view-toggle-display}) toggles between DocView and the underlying file contents. +@findex doc-view-open-text + When you visit a file which would normally be handled by DocView +mode but some requirement is not met (e.g., you operate in a terminal +frame or emacs has no PNG support), you are queried if you want to +view the document's contents as plain text. If you confirm, the +buffer is put in text mode and DocView minor mode is activated. Thus, +by typing @kbd{C-c C-c} you switch to the fallback mode. With another +@kbd{C-c C-c} you return to DocView mode. The plain text contents can +also be displayed from within DocView mode by typing @kbd{C-c C-t} +(@code{doc-view-open-text}). + You can explicitly enable DocView mode with the command @code{M-x doc-view-mode}. You can toggle DocView minor mode with @code{M-x doc-view-minor-mode}. === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-10-21 20:11:22 +0000 +++ lisp/ChangeLog 2014-10-22 13:30:16 +0000 @@ -1,3 +1,14 @@ +2014-10-22 Tassilo Horn + + * doc-view.el (doc-view-open-text): View the document's plain text + in the current buffer instead of a new one. + (doc-view-toggle-display): Handle the case where the current + buffer contains the plain text contents of the document. + (doc-view-initiate-display): Don't switch to fallback mode if the + user wants to view the doc's plain text. + (doc-view-set-doc-type): Use assoc-string instead of + assoc-ignore-case. + 2014-10-21 Stefan Monnier * subr.el (read-key): Fix clicks on the mode-line. === modified file 'lisp/doc-view.el' --- lisp/doc-view.el 2014-07-28 09:39:09 +0000 +++ lisp/doc-view.el 2014-10-22 13:30:16 +0000 @@ -1392,19 +1392,28 @@ (tooltip-show (doc-view-current-info))) (defun doc-view-open-text () - "Open a buffer with the current doc's contents as text." + "Display the current doc's contents as text." (interactive) (if doc-view--current-converter-processes (message "DocView: please wait till conversion finished.") - (let ((txt (expand-file-name "doc.txt" (doc-view--current-cache-dir))) - (bname (or buffer-file-name (buffer-name)))) + (let ((txt (expand-file-name "doc.txt" (doc-view--current-cache-dir)))) (if (file-readable-p txt) - (let ((name (concat "Text contents of " - (file-name-nondirectory bname))) - (dir (or (file-name-directory bname) default-directory))) - (with-current-buffer (find-file txt) - (rename-buffer name) - (setq default-directory dir))) + (let ((inhibit-read-only t) + (buffer-undo-list t) + (dv-bfn doc-view--buffer-file-name)) + (erase-buffer) + (set-buffer-multibyte t) + (insert-file-contents txt) + (text-mode) + (setq-local doc-view--buffer-file-name dv-bfn) + (set-buffer-modified-p nil) + (doc-view-minor-mode) + (add-hook 'write-file-functions + (lambda () + (when (eq major-mode 'text-mode) + (error "Cannot save text contents of document %s" + buffer-file-name))) + nil t)) (doc-view-doc->txt txt 'doc-view-open-text))))) ;;;;; Toggle between editing and viewing @@ -1416,20 +1425,30 @@ (defun doc-view-toggle-display () "Toggle between editing a document as text or viewing it." (interactive) - (if (eq major-mode 'doc-view-mode) - ;; Switch to editing mode - (progn - (doc-view-kill-proc) - (setq buffer-read-only nil) - ;; Switch to the previously used major mode or fall back to - ;; normal mode. - (doc-view-fallback-mode) - (doc-view-minor-mode 1)) + (cond + ((eq major-mode 'doc-view-mode) + ;; Switch to editing mode + (doc-view-kill-proc) + (setq buffer-read-only nil) + ;; Switch to the previously used major mode or fall back to + ;; normal mode. + (doc-view-fallback-mode) + (doc-view-minor-mode 1)) + ((eq major-mode 'text-mode) + (let ((buffer-undo-list t)) + ;; We're currently viewing the document's text contents, so switch + ;; back to . + (setq buffer-read-only nil) + (insert-file-contents doc-view--buffer-file-name nil nil nil t) + (doc-view-fallback-mode) + (doc-view-minor-mode 1) + (set-buffer-modified-p nil))) + (t ;; Switch to doc-view-mode (when (and (buffer-modified-p) (y-or-n-p "The buffer has been modified. Save the changes? ")) (save-buffer)) - (doc-view-mode))) + (doc-view-mode)))) ;;;; Searching @@ -1585,11 +1604,11 @@ (concat "No PNG support is available, or some conversion utility for " (file-name-extension doc-view--buffer-file-name) " files is missing.")) - (when (and (executable-find doc-view-pdftotext-program) - (y-or-n-p - "Unable to render file. View extracted text instead? ")) - (doc-view-open-text)) - (doc-view-toggle-display))) + (if (and (executable-find doc-view-pdftotext-program) + (y-or-n-p + "Unable to render file. View extracted text instead? ")) + (doc-view-open-text) + (doc-view-toggle-display)))) (defvar bookmark-make-record-function) @@ -1616,7 +1635,7 @@ "Figure out the current document type (`doc-view-doc-type')." (let ((name-types (when buffer-file-name - (cdr (assoc-ignore-case + (cdr (assoc-string (file-name-extension buffer-file-name) '( ;; DVI @@ -1634,7 +1653,8 @@ ;; Microsoft Office formats (also handled by the odf ;; conversion chain). ("doc" odf) ("docx" odf) ("xls" odf) ("xlsx" odf) - ("ppt" odf) ("pps" odf) ("pptx" odf)))))) + ("ppt" odf) ("pps" odf) ("pptx" odf)) + t)))) (content-types (save-excursion (goto-char (point-min)) ------------------------------------------------------------ revno: 118177 committer: martin rudalics branch nick: trunk timestamp: Wed 2014-10-22 12:01:17 +0200 message: Add two "+++"s to frame section of NEWS. diff: === modified file 'etc/NEWS' --- etc/NEWS 2014-10-21 15:27:18 +0000 +++ etc/NEWS 2014-10-22 10:01:17 +0000 @@ -372,6 +372,7 @@ *** New buffer-local variables `horizontal-scroll-bar' and `scroll-bar-height'. ++++ ** The height of a frame's menu and tool bar are no more counted in the frame's text height. This means that the text height stands only for the height of the frame's root window plus that of the echo area (if @@ -379,6 +380,7 @@ and menu bars (like in the Gtk builds) but has now been extended to all builds. ++++ ** Frames now do not necessarily preserve the number of columns or lines they display when setting default font, menu bar, fringe width, or scroll bars. In particular, maximized and fullscreen frames are ------------------------------------------------------------ revno: 118176 committer: martin rudalics branch nick: trunk timestamp: Wed 2014-10-22 11:57:17 +0200 message: Rewrite "Size and Position" section in frames.texi. * frames.texi (Size Parameters): Replace "frame contents" by "frame's text area". Add reference to Size and Position section. (Size and Position): Major rewrite. Add explanations for frame's default font, text and display areas. Add descriptions for `set-frame-font', `frame-text-height', `frame-text-width' and `frame-inhibit-implied-resize'. diff: === modified file 'doc/lispref/ChangeLog' --- doc/lispref/ChangeLog 2014-10-20 19:59:41 +0000 +++ doc/lispref/ChangeLog 2014-10-22 09:57:17 +0000 @@ -1,3 +1,13 @@ +2014-10-22 Martin Rudalics + + * frames.texi (Size Parameters): Replace "frame contents" by + "frame's text area". Add reference to Size and Position + section. + (Size and Position): Major rewrite. Add explanations for + frame's default font, text and display areas. Add descriptions + for `set-frame-font', `frame-text-height', `frame-text-width' + and `frame-inhibit-implied-resize'. + 2014-10-20 Glenn Morris * Merge in all changes up to 24.4 release. === modified file 'doc/lispref/frames.texi' --- doc/lispref/frames.texi 2014-10-09 04:23:09 +0000 +++ doc/lispref/frames.texi 2014-10-22 09:57:17 +0000 @@ -709,13 +709,13 @@ @table @code @vindex height, a frame parameter @item height -The height of the frame contents, in characters. (To get the height in -pixels, call @code{frame-pixel-height}; see @ref{Size and Position}.) +The height of the frame's text area (@pxref{Size and Position}), in +characters. @vindex width, a frame parameter @item width -The width of the frame contents, in characters. (To get the width in -pixels, call @code{frame-pixel-width}; see @ref{Size and Position}.) +The width of the frame's text area (@pxref{Size and Position}), in +characters. @vindex user-size, a frame parameter @item user-size @@ -739,9 +739,9 @@ does not allow resizing by mouse dragging. With some window managers you may have to customize the variable -@code{frame-resize-pixelwise} to a non-@code{nil} value in order to make -a frame appear ``maximized'' or ``fullscreen''. - +@code{frame-resize-pixelwise} (@pxref{Size and Position}) to a +non-@code{nil} value in order to make a frame appear ``maximized'' or +``fullscreen''. @end table @node Layout Parameters @@ -1136,65 +1136,137 @@ @code{scroll-bar} face. @end table + @node Size and Position -@subsection Frame Size And Position +@subsection Frame Size and Position @cindex size of frame @cindex screen size @cindex frame size @cindex resize frame - You can read or change the size and position of a frame using the -frame parameters @code{left}, @code{top}, @code{height}, and -@code{width}. Whatever geometry parameters you don't specify are chosen -by the window manager in its usual fashion. +You can read or change the size and position of a frame using the frame +parameters @code{left}, @code{top}, @code{height}, and @code{width}. +Whatever geometry parameters you don't specify are chosen by the window +manager in its usual fashion. Here are some special features for working with sizes and positions. -(For the precise meaning of ``selected frame'' used by these functions, -see @ref{Input Focus}.) +Most of the functions described below use a @var{frame} argument which +has to specify a live frame. If omitted or @code{nil}, it specifies the +selected frame, see @ref{Input Focus}. @defun set-frame-position frame left top This function sets the position of the top left corner of @var{frame} to @var{left} and @var{top}. These arguments are measured in pixels, and -normally count from the top left corner of the screen. - -Negative parameter values position the bottom edge of the window up from -the bottom edge of the screen, or the right window edge to the left of -the right edge of the screen. It would probably be better if the values -were always counted from the left and top, so that negative arguments -would position the frame partly off the top or left edge of the screen, -but it seems inadvisable to change that now. +normally count from the top left corner of the screen to the top left +corner of the rectangle allotted to the frame by the window manager. + +Negative parameter values position the bottom edge of that rectangle up +from the bottom edge of the screen, or the right rectangle edge to the +left of the right edge of the screen. It would probably be better if +the values were always counted from the left and top, so that negative +arguments would position the frame partly off the top or left edge of +the screen, but it seems inadvisable to change that now. +@end defun + +@cindex frame default font +@cindex default font of a frame +Each frame has a @dfn{default font} which specifies the canonical height +and width of a character on that frame. The default font is used when +retrieving or changing the size of a frame in terms of columns or lines. +It is also used when resizing (@pxref{Window Sizes}) or splitting +(@pxref{Splitting Windows}) windows. + +@defun frame-char-height &optional frame +@defunx frame-char-width &optional frame +These functions return the canonical height and width of a character in +@var{frame}, measured in pixels. Together, these values establish the +size of the default font on @var{frame}. The values depend on the +choice of font for @var{frame}, see @ref{Font and Color Parameters}. +@end defun + +The default font can be also set directly with the following function: + +@deffn Command set-frame-font font &optional keep-size frames +This sets the default font to @var{font}. When called interactively, it +prompts for the name of a font, and uses that font on the selected +frame. When called from Lisp, @var{font} should be a font name (a +string), a font object, font entity, or a font spec. + +If the optional argument @var{keep-size} is @code{nil}, this keeps the +number of frame lines and columns fixed. (If non-@code{nil}, the option +@code{frame-inhibit-implied-resize} described below will override this.) +If @var{keep-size} is non-@code{nil} (or with a prefix argument), it +tries to keep the size of the display area of the current frame fixed by +adjusting the number of lines and columns. + +If the optional argument @var{frames} is @code{nil}, this applies the +font to the selected frame only. If @var{frames} is non-@code{nil}, it +should be a list of frames to act upon, or @code{t} meaning all existing +graphical frames. +@end deffn + +@cindex frame display area +@cindex display area of a frame +The @dfn{display area} of a frame is a rectangular area within the area +allotted to the frame by the window manager. The display area neither +includes the title bar (@pxref{Frame Titles}) nor any other decorations +provided by the window manager (like an external border used for +resizing frames via mouse dragging). + + The actual height of the display area depends on the window-system +and toolkit in use. With GTK+, the display area does not include any +tool bar or menu bar. With the Motif or Lucid toolkits and with +Windows, the display area includes the tool bar but not the menu bar. +In a graphical version with no toolkit, it includes both the tool bar +and menu bar. On a text terminal, the display area includes the menu +bar. + +@defun frame-pixel-height &optional frame +@defunx frame-pixel-width &optional frame + These functions return the height and width of the display area of +@var{frame}, measured in pixels. For a text terminal, the results are +in characters rather than pixels. +@end defun + +@cindex frame text area +@cindex text area of a frame + The @dfn{text area} of a frame is a concept implicitly used by all +functions that change a frame's height or width. It is a rectangle +located within the display area. Its size is obtained from that of the +display area by subtracting the sizes of any tool or menu bars that are +part of the display area, any internal borders, one vertical and one +horizontal scroll bar, and one left and one right fringe as specified +for this frame, see @ref{Layout Parameters}. + +@defun frame-text-height &optional frame +@defunx frame-text-width &optional frame +These functions return the height and width of the text area of +@var{frame}, measured in pixels. For a text terminal, the results are +in characters rather than pixels. + +The value returned by @code{frame-text-height} differs from that +returned by @code{frame-pixel-height} by not including the heights of +any tool bar or menu bar, the height of one horizontal scroll bar and +the widths of the internal border. + +The value returned by @code{frame-text-width} differs from that returned +by @code{frame-pixel-width} by not including the width of one vertical +scroll bar, the widths of one left and one right fringe and the widths +of the internal border. @end defun @defun frame-height &optional frame @defunx frame-width &optional frame -These functions return the height and width of @var{frame}, measured in -lines and columns. If you don't supply @var{frame}, they use the -selected frame. -@end defun - -@defun frame-pixel-height &optional frame -@defunx frame-pixel-width &optional frame -These functions return the height and width of the main display area -of @var{frame}, measured in pixels. If you don't supply @var{frame}, -they use the selected frame. For a text terminal, the results are in -characters rather than pixels. - -These values include the internal borders, and windows' scroll bars -and fringes (which belong to individual windows, not to the frame -itself). The exact value of the heights depends on the window-system -and toolkit in use. With GTK+, the height does not include any tool -bar or menu bar. With the Motif or Lucid toolkits, it includes the -tool bar but not the menu bar. In a graphical version with no -toolkit, it includes both the tool bar and menu bar. For a text -terminal, the result includes the menu bar. -@end defun - -@defun frame-char-height &optional frame -@defunx frame-char-width &optional frame -These functions return the height and width of a character in -@var{frame}, measured in pixels. The values depend on the choice of -font. If you don't supply @var{frame}, these functions use the selected -frame. +These functions return the height and width of the text area of +@var{frame}, measured in units of the default font height and width of +@var{frame}. These functions are plain shorthands for writing +@code{(frame-parameter frame 'height)} and @code{(frame-parameter frame +'width)}. + +If the text area of @var{frame} measured in pixles is not a multiple of +its default font size, the values returned by this functions are rounded +down to the number of characters of the default font that fully fit into +the text area. @end defun @defopt frame-resize-pixelwise @@ -1220,9 +1292,9 @@ @end defopt @defun set-frame-size frame width height pixelwise -This function sets the size of @var{frame}, measured in characters; -@var{width} and @var{height} specify the new width in columns and the -new height in lines. +This function sets the size of the text area of @var{frame}, measured in +characters; @var{width} and @var{height} specify the new width in +columns and the new height in lines. The optional argument @var{pixelwise} non-@code{nil} means to measure the new width and height in units of pixels instead. Note that if @@ -1232,9 +1304,9 @@ @end defun @defun set-frame-height frame height &optional pretend pixelwise -This function resizes @var{frame} to a height of @var{height} lines. The -sizes of existing windows in @var{frame} are altered proportionally to -fit. +This function resizes the text area of @var{frame} to a height of +@var{height} lines. The sizes of existing windows in @var{frame} are +altered proportionally to fit. If @var{pretend} is non-@code{nil}, then Emacs displays @var{height} lines of output in @var{frame}, but does not change its value for the @@ -1254,8 +1326,8 @@ @end defun @defun set-frame-width frame width &optional pretend pixelwise -This function sets the width of @var{frame}, measured in characters. -The argument @var{pretend} has the same meaning as in +This function sets the width of the text area of @var{frame}, measured +in characters. The argument @var{pretend} has the same meaning as in @code{set-frame-height}. The optional fourth argument @var{pixelwise} non-@code{nil} means that @@ -1265,6 +1337,41 @@ to a multiple of its character width. @end defun +None of these three functions will make a frame smaller than needed to +display all of its windows together with their scroll bars, fringes, +margins, dividers, mode and header lines. This contrasts with requests +by the window manager triggered, for example, by dragging the external +border of a frame with the mouse. Such requests are always honored by +clipping, if necessary, portions that cannot be displayed at the right, +bottom corner of the frame. + + By default, Emacs tries to keep the number of lines and columns of a +frame's text area unaltered when, for example, adding or removing a menu +bar, changing the default font or setting the width of the frame's +scroll bars. This means, however, that in such case Emacs must ask the +window manager to resize the display area of the frame in order to +accommodate the size change. (Note that with the exception of GTK+ +builds, adding, removing or wrapping the tool bar usually do not resize +the frame's display area, hence these may alter the number of displayed +lines.) + + Occasionally, such implied resizing of the display area may be +unwanted, for example, when the frame is maximized or made fullscreen +where it's turned off by default. In other cases you can disable +implied resizing with the following option: + +@defopt frame-inhibit-implied-resize +If this option is @code{nil}, changing default font, menu bar mode, +fringe width, or scroll bars of a specific frame may resize the frame's +display area in order to preserve the number of columns or lines the +frame displays. If this option is non-@code{nil}, no such resizing is +done. + +When you add a tool bar or scroll bar to a frame that is not large +enough to accommodate one, Emacs will try to enlarge the frame even if +this option is non-@code{nil}. +@end defopt + @c FIXME? Belongs more in Emacs manual than here? @c But, e.g., fit-window-to-buffer is in this manual. If you have a frame that displays only one window, you can fit that ------------------------------------------------------------ revno: 118175 fixes bug: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=18015 committer: Stefan Monnier branch nick: trunk timestamp: Tue 2014-10-21 16:11:22 -0400 message: * lisp/mouse.el (mouse-drag-line): Use set-transient-map. (mouse--down-1-maybe-follows-link): Remove unused var `this-event'. (mouse-yank-secondary): Use gui-get-selection. (mouse--down-1-maybe-follows-link): Use read-key. * lisp/subr.el (read-key): Fix clicks on the mode-line. (set-transient-map): Return exit function. * lisp/xt-mouse.el: Add `event-kind' property on the fly from xterm-mouse-translate-1 rather than statically at the outset. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-10-21 16:05:13 +0000 +++ lisp/ChangeLog 2014-10-21 20:11:22 +0000 @@ -1,3 +1,16 @@ +2014-10-21 Stefan Monnier + + * subr.el (read-key): Fix clicks on the mode-line. + (set-transient-map): Return exit function. + + * mouse.el (mouse-drag-line): Use set-transient-map (bug#18015). + (mouse--down-1-maybe-follows-link): Remove unused var `this-event'. + (mouse-yank-secondary): Use gui-get-selection. + (mouse--down-1-maybe-follows-link): Use read-key. + + * xt-mouse.el: Add `event-kind' property on the fly from + xterm-mouse-translate-1 rather than statically at the outset. + 2014-10-21 Daniel Colascione * vc/vc-dispatcher.el (vc-resynch-window): Tell view-mode not to @@ -106,7 +119,7 @@ * mouse.el (mouse--down-1-maybe-follows-link): Remove unused var `this-event'. - (mouse-drag-line): Use there's no actual mouse, use the event's + (mouse-drag-line): Unless there's no actual mouse, use the event's position info. 2014-10-20 Stefan Monnier === modified file 'lisp/mouse.el' --- lisp/mouse.el 2014-10-02 03:19:32 +0000 +++ lisp/mouse.el 2014-10-21 20:11:22 +0000 @@ -102,8 +102,7 @@ (or mouse-1-click-in-non-selected-windows (eq (selected-window) (posn-window (event-start last-input-event))))) - (let ((this-event last-input-event) - (timedout + (let ((timedout (sit-for (if (numberp mouse-1-click-follows-link) (/ (abs mouse-1-click-follows-link) 1000.0) 0)))) @@ -112,7 +111,7 @@ timedout (not timedout)) nil - (let ((event (read-event))) + (let ((event (read-key))) ;Use read-key so it works for xterm-mouse-mode! (if (eq (car-safe event) (if (eq mouse-1-click-follows-link 'double) 'double-mouse-1 'mouse-1)) ;; Turn the mouse-1 into a mouse-2 to follow links. @@ -390,7 +389,7 @@ (frame-parameters frame))) 'right))) (draggable t) - height finished event position growth dragged) + height growth dragged) (cond ((eq line 'header) ;; Check whether header-line can be dragged at all. @@ -435,65 +434,81 @@ (not (zerop (window-right-divider-width window)))) (setq window (window-in-direction 'left window t))))) + (let* ((exitfun nil) + (move + (lambda (event) (interactive "e") + (let ((position + ;; For graphic terminals, we're better off using + ;; mouse-pixel-position for the following reasons: + ;; - when the mouse has moved outside of the frame, `event' + ;; does not contain any useful pixel position any more. + ;; - mouse-pixel-position is a bit more uptodate (the mouse + ;; may have moved still a bit further since the event was + ;; generated). + (if (display-mouse-p) + (mouse-pixel-position) + (let* ((posn (event-end event)) + (pos (posn-x-y posn)) + (w (posn-window posn)) + (pe (if (windowp w) (window-pixel-edges w)))) + (cons (if (windowp w) (window-frame w) w) + (if pe + (cons (+ (car pos) (nth 0 pe)) + (+ (cdr pos) (nth 1 pe))))))))) + (cond + ((not (and (eq (car position) frame) + (cadr position))) + nil) + ((eq line 'vertical) + ;; Drag vertical divider. This must be probably fixed like + ;; for the mode-line. + (setq growth (- (cadr position) + (if (eq side 'right) 0 2) + (nth 2 (window-pixel-edges window)) + -1)) + (unless (zerop growth) + (setq dragged t) + (adjust-window-trailing-edge window growth t t))) + (draggable + ;; Drag horizontal divider. + (setq growth + (if (eq line 'mode) + (- (+ (cddr position) height) + (nth 3 (window-pixel-edges window))) + ;; The window's top includes the header line! + (- (+ (nth 3 (window-pixel-edges window)) height) + (cddr position)))) + (unless (zerop growth) + (setq dragged t) + (adjust-window-trailing-edge + window (if (eq line 'mode) growth (- growth)) nil t)))))))) + ;; Start tracking. - (track-mouse - ;; Loop reading events and sampling the position of the mouse. - (while (not finished) - (setq event (read-event)) - (setq position (mouse-pixel-position)) - ;; Do nothing if - ;; - there is a switch-frame event. - ;; - the mouse isn't in the frame that we started in - ;; - the mouse isn't in any Emacs frame - ;; Drag if - ;; - there is a mouse-movement event - ;; - there is a scroll-bar-movement event (Why? -- cyd) - ;; (same as mouse movement for our purposes) - ;; Quit if - ;; - there is a keyboard event or some other unknown event. - (cond - ((not (consp event)) - (setq finished t)) - ((memq (car event) '(switch-frame select-window)) - nil) - ((not (memq (car event) '(mouse-movement scroll-bar-movement))) - (when (consp event) - ;; Do not unread a drag-mouse-1 event to avoid selecting - ;; some other window. For vertical line dragging do not - ;; unread mouse-1 events either (but only if we dragged at - ;; least once to allow mouse-1 clicks get through). - (unless (and dragged - (if (eq line 'vertical) - (memq (car event) '(drag-mouse-1 mouse-1)) - (eq (car event) 'drag-mouse-1))) - (push event unread-command-events))) - (setq finished t)) - ((not (and (eq (car position) frame) - (cadr position))) - nil) - ((eq line 'vertical) - ;; Drag vertical divider. This must be probably fixed like - ;; for the mode-line. - (setq growth (- (cadr position) - (if (eq side 'right) 0 2) - (nth 2 (window-pixel-edges window)) - -1)) - (unless (zerop growth) - (setq dragged t) - (adjust-window-trailing-edge window growth t t))) - (draggable - ;; Drag horizontal divider. - (setq growth - (if (eq line 'mode) - (- (+ (cddr position) height) - (nth 3 (window-pixel-edges window))) - ;; The window's top includes the header line! - (- (+ (nth 3 (window-pixel-edges window)) height) - (cddr position)))) - (unless (zerop growth) - (setq dragged t) - (adjust-window-trailing-edge - window (if (eq line 'mode) growth (- growth)) nil t)))))))) + (setq track-mouse t) + ;; Loop reading events and sampling the position of the mouse. + (setq exitfun + (set-transient-map + (let ((map (make-sparse-keymap))) + (define-key map [switch-frame] #'ignore) + (define-key map [select-window] #'ignore) + (define-key map [mouse-movement] move) + (define-key map [scroll-bar-movement] move) + ;; Swallow drag-mouse-1 events to avoid selecting some other window. + (define-key map [drag-mouse-1] + (lambda () (interactive) (funcall exitfun))) + ;; For vertical line dragging swallow also a mouse-1 + ;; event (but only if we dragged at least once to allow mouse-1 + ;; clicks to get through). + (when (eq line 'vertical) + (define-key map [mouse-1] + `(menu-item "" ,(lambda () (interactive) (funcall exitfun)) + :filter ,(lambda (cmd) (if dragged cmd))))) + ;; Some of the events will of course end up looked up + ;; with a mode-line or header-line prefix. + (define-key map [mode-line] map) + (define-key map [header-line] map) + map) + t (lambda () (setq track-mouse nil))))))) (defun mouse-drag-mode-line (start-event) "Change the height of a window by dragging on the mode line." @@ -1292,6 +1307,7 @@ (setq mouse-secondary-start (make-marker))) (set-marker mouse-secondary-start start-point) (delete-overlay mouse-secondary-overlay)) + ;; FIXME: Use mouse-drag-track! (let (event end end-point) (track-mouse (while (progn @@ -1350,7 +1366,7 @@ ;; Give temporary modes such as isearch a chance to turn off. (run-hooks 'mouse-leave-buffer-hook) (or mouse-yank-at-point (mouse-set-point click)) - (let ((secondary (x-get-selection 'SECONDARY))) + (let ((secondary (gui-get-selection 'SECONDARY))) (if secondary (insert-for-yank secondary) (error "No secondary selection")))) === modified file 'lisp/subr.el' --- lisp/subr.el 2014-10-06 07:00:33 +0000 +++ lisp/subr.el 2014-10-21 20:11:22 +0000 @@ -2008,7 +2008,14 @@ (or (cdr (assq 'tool-bar global-map)) (lookup-key global-map [tool-bar]))) map)) - (aref (catch 'read-key (read-key-sequence-vector prompt nil t)) 0)) + (let* ((keys + (catch 'read-key (read-key-sequence-vector prompt nil t))) + (key (aref keys 0))) + (if (and (> (length keys) 1) + (memq key '(mode-line header-line + left-fringe right-fringe))) + (aref keys 1) + key))) (cancel-timer timer) (use-global-map old-global-map)))) @@ -4348,20 +4355,27 @@ Normally, MAP is used only once, to look up the very next key. However, if the optional argument KEEP-PRED is t, MAP stays active if a key from MAP is used. KEEP-PRED can also be a -function of no arguments: if it returns non-nil, then MAP stays -active. +function of no arguments: it is called from `pre-command-hook' and +if it returns non-nil, then MAP stays active. Optional arg ON-EXIT, if non-nil, specifies a function that is called, with no arguments, after MAP is deactivated. This uses `overriding-terminal-local-map' which takes precedence over all other keymaps. As usual, if no match for a key is found in MAP, the normal key -lookup sequence then continues." - (let ((clearfun (make-symbol "clear-transient-map"))) +lookup sequence then continues. + +This returns an \"exit function\", which can be called with no argument +to deactivate this transient map, regardless of KEEP-PRED." + (let* ((clearfun (make-symbol "clear-transient-map")) + (exitfun + (lambda () + (internal-pop-keymap map 'overriding-terminal-local-map) + (remove-hook 'pre-command-hook clearfun) + (when on-exit (funcall on-exit))))) ;; Don't use letrec, because equal (in add/remove-hook) would get trapped ;; in a cycle. (fset clearfun - (suspicious-object (lambda () (with-demoted-errors "set-transient-map PCH: %S" (unless (cond @@ -4382,15 +4396,10 @@ (eq this-command (lookup-key map (this-command-keys-vector)))) (t (funcall keep-pred))) - (internal-pop-keymap map 'overriding-terminal-local-map) - (remove-hook 'pre-command-hook clearfun) - (when on-exit (funcall on-exit)) - ;; Comment out the fset if you want to debug the GC bug. -;;; (fset clearfun nil) -;;; (set clearfun nil) - ))))) + (funcall exitfun))))) (add-hook 'pre-command-hook clearfun) - (internal-push-keymap map 'overriding-terminal-local-map))) + (internal-push-keymap map 'overriding-terminal-local-map) + exitfun)) ;;;; Progress reporters. === modified file 'lisp/xt-mouse.el' --- lisp/xt-mouse.el 2014-07-19 16:56:40 +0000 +++ lisp/xt-mouse.el 2014-10-21 20:11:22 +0000 @@ -42,13 +42,6 @@ (defvar xterm-mouse-debug-buffer nil) -;; Mouse events symbols must have an 'event-kind property with -;; the value 'mouse-click. -(dolist (event '(mouse-1 mouse-2 mouse-3 mouse-4 mouse-5)) - (let ((M-event (intern (concat "M-" (symbol-name event))))) - (put event 'event-kind 'mouse-click) - (put M-event 'event-kind 'mouse-click))) - (defun xterm-mouse-translate (_event) "Read a click and release event from XTerm." (xterm-mouse-translate-1)) @@ -69,6 +62,10 @@ (vec (vector event)) (is-down (string-match "down-" (symbol-name ev-command)))) + ;; Mouse events symbols must have an 'event-kind property with + ;; the value 'mouse-click. + (when ev-command (put ev-command 'event-kind 'mouse-click)) + (cond ((null event) nil) ;Unknown/bogus byte sequence! (is-down ------------------------------------------------------------ revno: 118174 [merge] committer: Daniel Colascione branch nick: trunk timestamp: Tue 2014-10-21 17:05:13 +0100 message: Stop vc from burying buffers sometimes * vc/vc-dispatcher.el (vc-resynch-window): Tell view-mode not to change window configuration when we turn it off. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-10-21 15:27:18 +0000 +++ lisp/ChangeLog 2014-10-21 16:05:13 +0000 @@ -1,3 +1,8 @@ +2014-10-21 Daniel Colascione + + * vc/vc-dispatcher.el (vc-resynch-window): Tell view-mode not to + change window configuration when we turn it off. + 2014-10-21 Stefan Monnier Get rid of backend-dependent selection-handling functions for kill/yank === modified file 'lisp/vc/vc-dispatcher.el' --- lisp/vc/vc-dispatcher.el 2014-07-14 19:29:29 +0000 +++ lisp/vc/vc-dispatcher.el 2014-10-21 16:03:04 +0000 @@ -429,7 +429,7 @@ ;; even if the dispatcher client mode has messed with file contents (as in, ;; for example, VCS keyword expansion). -(declare-function view-mode-exit "view" (&optional return-to-alist exit-action all-win)) +(declare-function view-mode-exit "view" (&optional exit-only exit-action all-win)) (defun vc-position-context (posn) "Save a bit of the text around POSN in the current buffer. @@ -543,7 +543,7 @@ (if (file-writable-p file) (and view-mode (let ((view-old-buffer-read-only nil)) - (view-mode-exit))) + (view-mode-exit t))) (and (not view-mode) (not (eq (get major-mode 'mode-class) 'special)) (view-mode-enter)))) ------------------------------------------------------------ revno: 118173 committer: Stefan Monnier branch nick: trunk timestamp: Tue 2014-10-21 11:27:18 -0400 message: Get rid of backend-dependent selection-handling functions for kill/yank and make it generic instead by relying on the lower-level selection management functions. * select.el (select-enable-clipboard): Rename from gui-select-enable-clipboard. (select-enable-primary): Move from x-win.el and rename from x-select-enable-primary. (gui-last-selected-text): Remove. (gui--last-selected-text-clipboard, gui--last-selected-text-primary): New vars. (gui-select-text): Rewrite, based on x-win.el's old x-select-text. (gui-select-text-alist, gui-selection-value-alist): Remove. (x-select-request-type): Move from x-win.el. (gui--selection-value-internal): New function, taken from x-win's x-selection-value-internal. (gui-selection-value): Rewrite, based on x-win.el's old x-selection-value. (gui-set-selection-alist): Rename from gui-own-selection-alist and extend it to handle a nil value as a "disown" request. (gui-disown-selection-alist): Remove. (xselect-convert-to-delete): Adjust accordingly. (gui-set-selection): Simplify accordingly as well. Use dotimes. * lisp/frame.el (gui-method): Use window-system rather than framep. (gui-method-declare): The tty case is now nil rather than t. (make-frame): Adjust accordingly. * lisp/term/x-win.el (x-last-selected-text-primary) (x-select-enable-primary): Remove (moved to select.el). (x-select-request-type): Move to select.el. (x-selection-value-internal, x--selection-value): Remove functions. (gui-selection-value, gui-select-text): Remove moethods. (gui-set-selection): Merge own and disown methods. * lisp/startup.el (command-line): Adjust now that `gui-method' expects nil for ttys. * lisp/term/ns-win.el (ns-get-pasteboard, ns-set-pasteboard) (ns-selection-value): Remove functions. (gui-select-text, gui-selection-value): Don't define method any more. (gui-set-selection): Merge the old own and disown methods. (gui-selection-exists-p, gui-get-selection): Adjust to new name of underlying C primitive. * lisp/term/pc-win.el (w16-get-selection-value): Add dummy argument and drop test of gui-select-enable-clipboard, to make it usable as a gui-get-selection method. (gui-selection-exists-p): Adjust to new name of C primitive. (gui-set-selection): Merge own and disown methods. (gui-select-text, gui-selection-value): Delete methods. (w16--select-text): Delete function. * lisp/term/w32-win.el (w32--select-text, w32--get-selection-value): Delete function (move functionality into w32--set-selection and w32--get-selection). (gui-select-text, gui-selection-value): Don't define methods. (w32--set-selection, w32--get-selection, w32--selection-owner-p): New functions. (gui-get-selection, gui-selection-owner-p, gui-selection-exists-p): Use them. (gui-selection-exists-p): Adjust to new name of C primitive. * src/nsselect.m (ns_get_local_selection): Signal error rather than `quit'. (Fns_own_selection_internal): Tighten scoping. (Fns_selection_exists_p): Rename from Fx_selection_exists_p. (Fns_get_selection): Rename from Fx_get_selection_internal. (Fns_get_selection_internal, Fns_store_selection_internal): Remove functions. (syms_of_nsselect): Adjust accordingly. * src/w16select.c (Fw16_selection_exists_p): Rename from Fx_selection_exists_p. (syms_of_win16select): Adjust accordingly. * src/w32select.c (Fw32_selection_exists_p): Rename from Fx_selection_exists_p. (syms_of_w32select): Adjust accordingly. diff: === modified file 'etc/NEWS' --- etc/NEWS 2014-10-20 16:36:34 +0000 +++ etc/NEWS 2014-10-21 15:27:18 +0000 @@ -49,8 +49,12 @@ * Changes in Emacs 25.1 -** x-select-enable-clipboard is renamed gui-select-enable-clipboard. -Additionally it now also applies to OSX and GNUstep. +** x-select-enable-clipboard is renamed select-enable-clipboard. +x-select-enable-primary and renamed select-enable-primary. +Additionally they both now apply to all systems (OSX, GNUstep, Windows, you +name it), with the proviso that on some systems (e.g. Windows) +select-enable-primary is ineffective since the system doesn't +have the equivalent of a primary selection. +++ ** terpri gets an optional arg ENSURE to conditionally output a newline. === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-10-21 01:35:30 +0000 +++ lisp/ChangeLog 2014-10-21 15:27:18 +0000 @@ -1,5 +1,69 @@ 2014-10-21 Stefan Monnier + Get rid of backend-dependent selection-handling functions for kill/yank + and make it generic instead by relying on the lower-level selection + management functions. + + * select.el (select-enable-clipboard): Rename from + gui-select-enable-clipboard. + (select-enable-primary): Move from x-win.el and rename from + x-select-enable-primary. + (gui-last-selected-text): Remove. + (gui--last-selected-text-clipboard, gui--last-selected-text-primary): + New vars. + (gui-select-text): Rewrite, based on x-win.el's old x-select-text. + (gui-select-text-alist, gui-selection-value-alist): Remove. + (x-select-request-type): Move from x-win.el. + (gui--selection-value-internal): New function, taken from x-win's + x-selection-value-internal. + (gui-selection-value): Rewrite, based on x-win.el's old x-selection-value. + (gui-set-selection-alist): Rename from gui-own-selection-alist and + extend it to handle a nil value as a "disown" request. + (gui-disown-selection-alist): Remove. + (xselect-convert-to-delete): Adjust accordingly. + (gui-set-selection): Simplify accordingly as well. Use dotimes. + + * term/x-win.el (x-last-selected-text-primary) + (x-select-enable-primary): Remove (moved to select.el). + (x-select-request-type): Move to select.el. + (x-selection-value-internal, x--selection-value): Remove functions. + (gui-selection-value, gui-select-text): Remove moethods. + (gui-set-selection): Merge own and disown methods. + + * term/w32-win.el (w32--select-text, w32--get-selection-value): + Delete function (move functionality into w32--set-selection and + w32--get-selection). + (gui-select-text, gui-selection-value): Don't define methods. + (w32--set-selection, w32--get-selection, w32--selection-owner-p): + New functions. + (gui-get-selection, gui-selection-owner-p, gui-selection-exists-p): + Use them. + (gui-selection-exists-p): Adjust to new name of C primitive. + + * term/pc-win.el (w16-get-selection-value): Add dummy argument and drop + test of gui-select-enable-clipboard, to make it usable as + a gui-get-selection method. + (gui-selection-exists-p): Adjust to new name of C primitive. + (gui-set-selection): Merge own and disown methods. + (gui-select-text, gui-selection-value): Delete methods. + (w16--select-text): Delete function. + + * term/ns-win.el (ns-get-pasteboard, ns-set-pasteboard) + (ns-selection-value): Remove functions. + (gui-select-text, gui-selection-value): Don't define method any more. + (gui-set-selection): Merge the old own and disown methods. + (gui-selection-exists-p, gui-get-selection): Adjust to new name of + underlying C primitive. + + * startup.el (command-line): Adjust now that `gui-method' expects nil + for ttys. + + * frame.el (gui-method): Use window-system rather than framep. + (gui-method-declare): The tty case is now nil rather than t. + (make-frame): Adjust accordingly. + +2014-10-21 Stefan Monnier + * net/newst-reader.el (newsticker--image-read): Simplify. (newsticker--icon-read): Use dolist and fix free var error. === modified file 'lisp/frame.el' --- lisp/frame.el 2014-10-09 04:23:09 +0000 +++ lisp/frame.el 2014-10-21 15:27:18 +0000 @@ -32,7 +32,7 @@ (intern (format "%s-alist" base))) (defmacro gui-method (name &optional type) - (macroexp-let2 nil type (or type `(framep (selected-frame))) + (macroexp-let2 nil type (or type `window-system) `(alist-get ,type ,(gui-method--name name) (lambda (&rest _args) (error "No method %S for %S frame" ',name ,type))))) @@ -43,7 +43,7 @@ (defmacro gui-method-declare (name &optional tty-fun doc) (declare (doc-string 3) (indent 2)) `(defvar ,(gui-method--name name) - ,(if tty-fun `(list (cons t ,tty-fun))) ,doc)) + ,(if tty-fun `(list (cons nil ,tty-fun))) ,doc)) (defmacro gui-call (name &rest args) `(funcall (gui-method ,name) ,@args)) @@ -646,23 +646,22 @@ the new frame according to its own rules." (interactive) (let* ((display (cdr (assq 'display parameters))) - (w (or - (cond - ((assq 'terminal parameters) - (let ((type (terminal-live-p - (cdr (assq 'terminal parameters))))) - (cond - ((null type) (error "Terminal %s does not exist" - (cdr (assq 'terminal parameters)))) - (t type)))) - ((assq 'window-system parameters) - (cdr (assq 'window-system parameters))) - (display - (or (window-system-for-display display) - (error "Don't know how to interpret display %S" - display))) - (t window-system)) - t)) + (w (cond + ((assq 'terminal parameters) + (let ((type (terminal-live-p + (cdr (assq 'terminal parameters))))) + (cond + ((eq t type) nil) + ((null type) (error "Terminal %s does not exist" + (cdr (assq 'terminal parameters)))) + (t type)))) + ((assq 'window-system parameters) + (cdr (assq 'window-system parameters))) + (display + (or (window-system-for-display display) + (error "Don't know how to interpret display %S" + display))) + (t window-system))) (oldframe (selected-frame)) (params parameters) frame) === modified file 'lisp/select.el' --- lisp/select.el 2014-10-10 03:28:24 +0000 +++ lisp/select.el 2014-10-21 15:27:18 +0000 @@ -24,30 +24,17 @@ ;; Based partially on earlier release by Lucid. -;; The functionality here is pretty messy, because there are different -;; functions that claim to get or set the "selection", with no clear -;; distinction between them. Here's my best understanding of it: -;; - gui-select-text and gui-selection-value go together to access the general -;; notion of "GUI selection" for interoperation with other applications. -;; This can use either the clipboard or the primary selection, or both or -;; none according to gui-select-enable-clipboard and x-select-enable-primary. -;; These are the default values of interprogram-cut/paste-function. -;; - gui-get-primary-selection is used to get the PRIMARY selection, -;; specifically for mouse-yank-primary. -;; - gui-get-selection and gui-set-selection are lower-level functions meant to -;; access various kinds of selections (CLIPBOARD, PRIMARY, SECONDARY). - -;; Currently gui-select-text and gui-selection-value provide gui-methods so the -;; actual backend can do it whichever way it wants. This means for example -;; that gui-select-enable-clipboard is defined here but implemented in each and -;; every backend. -;; Maybe a better structure would be to make gui-select-text and -;; gui-selection-value have no associated gui-method, and implement -;; gui-select-enable-clipboard (and x-select-enable-clipboard) themselves. -;; This would instead rely on gui-get/set-selection being implemented well -;; (e.g. currently w32's implementation thereof sucks, for example, -;; since it doesn't access the system's clipboard when setting/getting the -;; CLIPBOARD selection). +;; The functionality here is divided in two parts: +;; - Low-level: gui-get-selection, gui-set-selection, gui-selection-owner-p, +;; gui-selection-exists-p are the backend-dependent functions meant to access +;; various kinds of selections (CLIPBOARD, PRIMARY, SECONDARY). +;; - Higher-level: gui-select-text and gui-selection-value go together to +;; access the general notion of "GUI selection" for interoperation with other +;; applications. This can use either the clipboard or the primary selection, +;; or both or none according to select-enable-clipboard/primary. These are +;; the default values of interprogram-cut/paste-function. +;; Additionally, there's gui-get-primary-selection which is used to get the +;; PRIMARY selection, specifically for mouse-yank-primary. ;;; Code: @@ -99,7 +86,7 @@ ;; Only declared obsolete in 23.3. (define-obsolete-function-alias 'x-selection 'x-get-selection "at least 19.34") -(defcustom gui-select-enable-clipboard t +(defcustom select-enable-clipboard t "Non-nil means cutting and pasting uses the clipboard. This can be in addition to, but in preference to, the primary selection, if applicable (i.e. under X11)." @@ -108,12 +95,158 @@ ;; The GNU/Linux version changed in 24.1, the MS-Windows version did not. :version "24.1") (define-obsolete-variable-alias 'x-select-enable-clipboard - 'gui-select-enable-clipboard "25.1") - -(gui-method-declare gui-select-text #'ignore - "Method used to pass the current selection to the system. -Called with one argument (the text selected). -Should obey `gui-select-enable-clipboard' where applicable.") + 'select-enable-clipboard "25.1") + +(defcustom select-enable-primary nil + "Non-nil means cutting and pasting uses the primary selection +The existence of a primary selection depends on the underlying GUI you use. +E.g. it doesn't exist under MS-Windows." + :type 'boolean + :group 'killing + :version "24.1") +(define-obsolete-variable-alias 'x-select-enable-primary + 'select-enable-primary "25.1") + +;; We keep track of the last text selected here, so we can check the +;; current selection against it, and avoid passing back our own text +;; from gui-selection-value. We track both +;; separately in case another X application only sets one of them +;; we aren't fooled by the PRIMARY or CLIPBOARD selection staying the same. + +(defvar gui--last-selected-text-clipboard nil + "The value of the CLIPBOARD selection last seen.") +(defvar gui--last-selected-text-primary nil + "The value of the PRIMARY selection last seen.") + +(defun gui-select-text (text) + "Select TEXT, a string, according to the window system. +if `select-enable-clipboard' is non-nil, copy TEXT to the system's clipboard. +If `select-enable-primary' is non-nil, put TEXT in the primary selection. + +MS-Windows does not have a \"primary\" selection." + (when select-enable-primary + (gui-set-selection 'PRIMARY text) + (setq gui--last-selected-text-primary text)) + (when select-enable-clipboard + ;; When cutting, the selection is cleared and PRIMARY + ;; set to the empty string. Prevent that, PRIMARY + ;; should not be reset by cut (Bug#16382). + (setq saved-region-selection text) + (gui-set-selection 'CLIPBOARD text) + (setq gui--last-selected-text-clipboard text))) +(define-obsolete-function-alias 'x-select-text 'gui-select-text "25.1") + +(defcustom x-select-request-type nil + "Data type request for X selection. +The value is one of the following data types, a list of them, or nil: + `COMPOUND_TEXT', `UTF8_STRING', `STRING', `TEXT' + +If the value is one of the above symbols, try only the specified type. + +If the value is a list of them, try each of them in the specified +order until succeed. + +The value nil is the same as the list (UTF8_STRING COMPOUND_TEXT STRING)." + :type '(choice (const :tag "Default" nil) + (const COMPOUND_TEXT) + (const UTF8_STRING) + (const STRING) + (const TEXT) + (set :tag "List of values" + (const COMPOUND_TEXT) + (const UTF8_STRING) + (const STRING) + (const TEXT))) + :group 'killing) + +;; Get a selection value of type TYPE by calling gui-get-selection with +;; an appropriate DATA-TYPE argument decided by `x-select-request-type'. +;; The return value is already decoded. If gui-get-selection causes an +;; error, this function return nil. + +(defun gui--selection-value-internal (type) + (let ((request-type (if (eq window-system 'x) + (or x-select-request-type + '(UTF8_STRING COMPOUND_TEXT STRING)) + 'STRING)) + text) + (with-demoted-errors "gui-get-selection: %S" + (if (consp request-type) + (while (and request-type (not text)) + (setq text (gui-get-selection type (car request-type))) + (setq request-type (cdr request-type))) + (setq text (gui-get-selection type request-type)))) + (if text + (remove-text-properties 0 (length text) '(foreign-selection nil) text)) + text)) + +(defun gui-selection-value () + (let ((clip-text + (when select-enable-clipboard + (let ((text (gui--selection-value-internal 'CLIPBOARD))) + (if (string= text "") (setq text nil)) + + ;; Check the CLIPBOARD selection for 'newness', is it different + ;; from what we remembered them to be last time we did a + ;; cut/paste operation. + (prog1 + (unless (equal text gui--last-selected-text-clipboard) + text) + (setq gui--last-selected-text-clipboard text))))) + (primary-text + (when select-enable-primary + (let ((text (gui--selection-value-internal 'PRIMARY))) + (if (string= text "") (setq text nil)) + ;; Check the PRIMARY selection for 'newness', is it different + ;; from what we remembered them to be last time we did a + ;; cut/paste operation. + (prog1 + (unless (equal text gui--last-selected-text-primary) + text) + (setq gui--last-selected-text-primary text)))))) + + ;; As we have done one selection, clear this now. + (setq next-selection-coding-system nil) + + ;; At this point we have recorded the current values for the + ;; selection from clipboard (if we are supposed to) and primary. + ;; So return the first one that has changed + ;; (which is the first non-null one). + ;; + ;; NOTE: There will be cases where more than one of these has + ;; changed and the new values differ. This indicates that + ;; something like the following has happened since the last time + ;; we looked at the selections: Application X set all the + ;; selections, then Application Y set only one of them. + ;; In this case since we don't have + ;; timestamps there is no way to know what the 'correct' value to + ;; return is. The nice thing to do would be to tell the user we + ;; saw multiple possible selections and ask the user which was the + ;; one they wanted. + (or clip-text primary-text) + )) + +(define-obsolete-function-alias 'x-selection-value 'gui-selection-value "25.1") + +(defun x-get-clipboard () + "Return text pasted to the clipboard." + (declare (obsolete gui-get-selection "25.1")) + (gui-call gui-get-selection 'CLIPBOARD 'STRING)) + +(defun gui-get-primary-selection () + "Return the PRIMARY selection, or the best emulation thereof." + (or (gui-get-selection 'PRIMARY) + (and (fboundp 'w32-get-selection-value) + (eq (framep (selected-frame)) 'w32) + ;; MS-Windows emulates PRIMARY in x-get-selection, but only + ;; within the Emacs session, so consult the clipboard if + ;; primary is not found. + (w32-get-selection-value)) + (error "No selection is available"))) +(define-obsolete-function-alias 'x-get-selection-value + 'gui-get-primary-selection "25.1") + +;;; Lower-level, backend dependent selection handling. (gui-method-declare gui-get-selection #'ignore "Return selected text. @@ -122,46 +255,30 @@ \(Those are literal upper-case symbol names, since that's what X expects.) TARGET-TYPE is the type of data desired, typically `STRING'.") -(defvar gui-last-selected-text nil - ;; We keep track of the last text selected here, so we can check the - ;; current selection against it, and avoid passing back our own text - ;; from gui-selection-value. - "Last text passed to `gui-select-text'.") - -(defun gui-select-text (text) - "Select TEXT, a string, according to the window system. -if `gui-select-enable-clipboard' is non-nil, copy TEXT to the system's clipboard. - -On X, if `x-select-enable-primary' is non-nil, put TEXT in -the primary selection. - -On MS-Windows, make TEXT the current selection." - ;; FIXME: We should test gui-select-enable-clipboard here! - ;; But that would break the independence between x-select-enable-primary - ;; and x-select-enable-clipboard! - ;;(when gui-select-enable-clipboard - (gui-call gui-select-text text) ;;) - (setq gui-last-selected-text text)) -(define-obsolete-function-alias 'x-select-text 'gui-select-text "25.1") - -(gui-method-declare gui-selection-value #'ignore - "Method to return the GUI's selection. -Takes no argument, and returns a string. -Should obey `gui-select-enable-clipboard'.") - -(defun gui-selection-value () - (let ((text (gui-call gui-selection-value))) - (if (string= text "") (setq text nil)) - (cond - ((not text) nil) - ((eq text gui-last-selected-text) nil) - ((string= text gui-last-selected-text) - ;; Record the newer string, so subsequent calls can use the `eq' test. - (setq gui-last-selected-text text) - nil) - (t - (setq gui-last-selected-text text))))) -(define-obsolete-function-alias 'x-selection-value 'gui-selection-value "25.1") +(gui-method-declare gui-set-selection nil + "Method to assert a selection of type SELECTION and value VALUE. +SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'. +If VALUE is nil and we own the selection SELECTION, disown it instead. +Disowning it means there is no such selection. +\(Those are literal upper-case symbol names, since that's what X expects.) +VALUE is typically a string, or a cons of two markers, but may be +anything that the functions on `selection-converter-alist' know about. + +Called with 2 args: (SELECTION VALUE).") + +(gui-method-declare gui-selection-owner-p #'ignore + "Whether the current Emacs process owns the given X Selection. +Called with one argument: (SELECTION). +The arg should be the name of the selection in question, typically one of +the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'. +\(Those are literal upper-case symbol names, since that's what X expects.)") + +(gui-method-declare gui-selection-exists-p #'ignore + "Whether there is an owner for the given X Selection. +Called with one argument: (SELECTION). +The arg should be the name of the selection in question, typically one of +the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'. +\(Those are literal upper-case symbol names, since that's what X expects.)") (defun gui-get-selection (&optional type data-type) "Return the value of an X Windows selection. @@ -197,53 +314,6 @@ data)) (define-obsolete-function-alias 'x-get-selection 'gui-get-selection "25.1") -(defun x-get-clipboard () - "Return text pasted to the clipboard." - (declare (obsolete gui-get-selection "25.1")) - (gui-call gui-get-selection 'CLIPBOARD 'STRING)) - -(defun gui-get-primary-selection () - "Return the PRIMARY selection, or the best emulation thereof." - (or (gui-get-selection 'PRIMARY) - (and (fboundp 'w32-get-selection-value) - (eq (framep (selected-frame)) 'w32) - ;; MS-Windows emulates PRIMARY in x-get-selection, but only - ;; within the Emacs session, so consult the clipboard if - ;; primary is not found. - (w32-get-selection-value)) - (error "No selection is available"))) -(define-obsolete-function-alias 'x-get-selection-value - 'gui-get-primary-selection "25.1") - -(gui-method-declare gui-own-selection nil - "Method to assert a selection of type SELECTION and value VALUE. -SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'. -(Those are literal upper-case symbol names, since that's what X expects.) -VALUE is typically a string, or a cons of two markers, but may be -anything that the functions on `selection-converter-alist' know about. - -Called with 2 args: (SELECTION VALUE).") - -(gui-method-declare gui-disown-selection nil - "If we own the selection SELECTION, disown it. -Disowning it means there is no such selection. - -Called with one argument: (SELECTION)") - -(gui-method-declare gui-selection-owner-p #'ignore - "Whether the current Emacs process owns the given X Selection. -Called with one argument: (SELECTION). -The arg should be the name of the selection in question, typically one of -the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'. -(Those are literal upper-case symbol names, since that's what X expects.)") - -(gui-method-declare gui-selection-exists-p #'ignore - "Whether there is an owner for the given X Selection. -Called with one argument: (SELECTION). -The arg should be the name of the selection in question, typically one of -the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'. -(Those are literal upper-case symbol names, since that's what X expects.)") - (defun gui-set-selection (type data) "Make an X selection of type TYPE and value DATA. The argument TYPE (nil means `PRIMARY') says which selection, and @@ -274,18 +344,14 @@ (if (stringp type) (setq type (intern type))) (or (gui--valid-simple-selection-p data) (and (vectorp data) - (let ((valid t) - (i (1- (length data)))) - (while (>= i 0) + (let ((valid t)) + (dotimes (i (length data)) (or (gui--valid-simple-selection-p (aref data i)) - (setq valid nil)) - (setq i (1- i))) + (setq valid nil))) valid)) (signal 'error (list "invalid selection" data))) (or type (setq type 'PRIMARY)) - (if data - (gui-call gui-own-selection type data) - (gui-call gui-disown-selection type)) + (gui-call gui-set-selection type data) data) (define-obsolete-function-alias 'x-set-selection 'gui-set-selection "25.1") @@ -295,13 +361,13 @@ (markerp (car data)) (markerp (cdr data)) (marker-buffer (car data)) - (buffer-name (marker-buffer (car data))) + (buffer-live-p (marker-buffer (car data))) (eq (marker-buffer (car data)) (marker-buffer (cdr data)))) (stringp data) (and (overlayp data) (overlay-buffer data) - (buffer-name (overlay-buffer data))) + (buffer-live-p (overlay-buffer data))) (symbolp data) (integerp data))) @@ -445,7 +511,7 @@ (apply 'vector all))) (defun xselect-convert-to-delete (selection _type _value) - (gui-call gui-disown-selection selection) + (gui-call gui-set-selection selection nil) ;; A return value of nil means that we do not know how to do this conversion, ;; and replies with an "error". A return value of NULL means that we have ;; done the conversion (and any side-effects) but have no value to return. === modified file 'lisp/simple.el' --- lisp/simple.el 2014-10-14 18:10:37 +0000 +++ lisp/simple.el 2014-10-21 15:27:18 +0000 @@ -5363,7 +5363,8 @@ ((car (posn-x-y posn)) (setq temporary-goal-column (cons (/ (float (car (posn-x-y posn))) - (frame-char-width)) hscroll)))))) + (frame-char-width)) + hscroll)))))) (if target-hscroll (set-window-hscroll (selected-window) target-hscroll)) ;; vertical-motion can move more than it was asked to if it moves === modified file 'lisp/startup.el' --- lisp/startup.el 2014-10-04 18:58:41 +0000 +++ lisp/startup.el 2014-10-21 15:27:18 +0000 @@ -950,11 +950,11 @@ ;; Process window-system specific command line parameters. (setq command-line-args (funcall - (gui-method handle-args-function (or initial-window-system t)) + (gui-method handle-args-function initial-window-system) command-line-args)) ;; Initialize the window system. (Open connection, etc.) (funcall - (gui-method window-system-initialization (or initial-window-system t))) + (gui-method window-system-initialization initial-window-system)) (put initial-window-system 'window-system-initialized t)) ;; If there was an error, print the error message and exit. (error === modified file 'lisp/term/ns-win.el' --- lisp/term/ns-win.el 2014-10-10 03:28:24 +0000 +++ lisp/term/ns-win.el 2014-10-21 15:27:18 +0000 @@ -726,25 +726,6 @@ 'ns-store-selection-internal "24.1") -(defun ns-get-pasteboard () - "Returns the value of the pasteboard." - (ns-get-selection-internal 'CLIPBOARD)) - -(defun ns-set-pasteboard (string) - "Store STRING into the pasteboard of the Nextstep display server." - ;; Check the data type of STRING. - (if (not (stringp string)) (error "Nonstring given to pasteboard")) - (ns-store-selection-internal 'CLIPBOARD string)) - -;; Return the value of the current Nextstep selection. For -;; compatibility with older Nextstep applications, this checks cut -;; buffer 0 before retrieving the value of the primary selection. -(gui-method-define gui-selection-value ns #'ns-selection-value) -(defun ns-selection-value () - ;; Consult the selection. Treat empty strings as if they were unset. - (if gui-select-enable-clipboard - (ns-get-pasteboard))) - (defun ns-copy-including-secondary () (interactive) (call-interactively 'kill-ring-save) @@ -950,19 +931,13 @@ (gui-method-define window-system-initialization ns #'ns-initialize-window-system) -(declare-function ns-set-pasteboard "ns-win" (string)) -(gui-method-define gui-select-text ns - (lambda (text) - ;; Don't send the pasteboard too much text. - ;; It becomes slow, and if really big it causes errors. - (when gui-select-enable-clipboard - (ns-set-pasteboard text)))) - -(gui-method-define gui-own-selection ns #'ns-own-selection-internal) -(gui-method-define gui-disown-selection ns #'ns-disown-selection-internal) +(gui-method-define gui-set-selection ns + (lambda (selection value) + (if value (ns-own-selection-internal selection value) + (ns-disown-selection-internal selection)))) (gui-method-define gui-selection-owner-p ns #'ns-selection-owner-p) -(gui-method-define gui-selection-exists-p ns #'x-selection-exists-p) -(gui-method-define gui-get-selection ns #'x-get-selection-internal) ;FIXME:name! +(gui-method-define gui-selection-exists-p ns #'ns-selection-exists-p) +(gui-method-define gui-get-selection ns #'ns-get-selection) (provide 'ns-win) === modified file 'lisp/term/pc-win.el' --- lisp/term/pc-win.el 2014-10-10 03:28:24 +0000 +++ lisp/term/pc-win.el 2014-10-21 15:27:18 +0000 @@ -219,16 +219,15 @@ ; ;;;; Selections ; -(defun w16-get-selection-value () +(defun w16-get-selection-value (_selection-symbol _target-type) "Return the value of the current selection. Consult the selection. Treat empty strings as if they were unset." - (if gui-select-enable-clipboard - ;; Don't die if x-get-selection signals an error. - (with-demoted-errors "w16-get-clipboard-data:%s" - (w16-get-clipboard-data)))) + ;; Don't die if x-get-selection signals an error. + (with-demoted-errors "w16-get-clipboard-data:%s" + (w16-get-clipboard-data))) ;; gui-selection-owner-p is used in simple.el. -(gui-method-define gui-selection-exists-p pc #'x-selection-exists-p) +(gui-method-define gui-selection-exists-p pc #'w16-selection-exists-p) (gui-method-define gui-selection-owner-p pc #'w16-selection-owner-p) (defun w16-selection-owner-p (_selection) ;; FIXME: Other systems don't obey gui-select-enable-clipboard here. @@ -248,24 +247,22 @@ text) (t nil))))) -;; gui-own-selection and gui-disown-selection are used in gui-set-selection. -(gui-method-define gui-own-selection pc - (lambda (_selection value) - ;; FIXME: Other systems don't obey - ;; gui-select-enable-clipboard here. - (ignore-errors - (w16--select-text value)) - value)) - -(gui-method-define gui-disown-selection pc - (lambda (selection &optional _time-object _terminal) - (if (w16-selection-owner-p selection) - t))) +;; gui-set-selection is used in gui-set-selection. +(declare-function w16-set-clipboard-data "w16select.c" + (string &optional ignored)) +(gui-method-define gui-set-selection pc + (lambda (selection value) + (if (not value) + (if (w16-selection-owner-p selection) + t) + ;; FIXME: Other systems don't obey + ;; gui-select-enable-clipboard here. + (with-demoted-errors "w16-set-clipboard-data: %S" + (w16-set-clipboard-data value)) + value))) ;; gui-get-selection is used in select.el -(gui-method-define gui-get-selection pc - (lambda (selection-symbol target-type) - (w16-get-selection-value))) +(gui-method-define gui-get-selection pc #'w16-get-selection-value) ;; From src/fontset.c: (fset 'query-fontset 'ignore) @@ -384,13 +381,6 @@ (gui-method-define handle-args-function pc #'tty-handle-args) -(declare-function w16-set-clipboard-data "w16select.c" - (string &optional ignored)) -(gui-method-define gui-select-text pc #'w16--select-text) -(gui-method-define gui-selection-value pc #'w16-get-selection-value) -(defun w16--select-text (text) - (when gui-select-enable-clipboard - (w16-set-clipboard-data text))) ;; --------------------------------------------------------------------------- === modified file 'lisp/term/w32-win.el' --- lisp/term/w32-win.el 2014-10-10 03:28:24 +0000 +++ lisp/term/w32-win.el 2014-10-21 15:27:18 +0000 @@ -382,45 +382,35 @@ (string &optional ignored)) (declare-function w32-get-clipboard-data "w32select.c") -(defun w32--select-text (text) - (if gui-select-enable-clipboard (w32-set-clipboard-data text))) +;;; Fix interface to (X-specific) mouse.el +(defun w32--set-selection (type value) + (if (eq type 'CLIPBOARD) + (w32-set-clipboard-data text) + (put 'x-selections (or type 'PRIMARY) data))) -(defun w32--get-selection-value () - "Return the value of the current selection. -Consult the selection. Treat empty strings as if they were unset." - (if gui-select-enable-clipboard - ;; Don't die if x-get-selection signals an error. +(defun w32--get-selection (&optional type data-type) + (if (and (eq type 'CLIPBOARD) + (eq data-type 'STRING)) (with-demoted-errors "w32-get-clipboard-data:%S" - (w32-get-clipboard-data)))) - -;; Arrange for the kill and yank functions to set and check the clipboard. -(gui-method-define gui-select-text w32 #'w32--select-text) -(gui-method-define gui-selection-value w32 #'w32--get-selection-value) + (w32-get-clipboard-data)) + (get 'x-selections (or type 'PRIMARY)))) + +(defun w32--selection-owner-p (selection) + (and (memq selection '(nil PRIMARY SECONDARY)) + (get 'x-selections (or selection 'PRIMARY)))) + +(gui-method-define gui-set-selection w32 #'w32--set-selection) +(gui-method-define gui-get-selection w32 #'w32--get-selection) + +(gui-method-define gui-selection-owner-p w32 #'w32--selection-owner-p) +(gui-method-define gui-selection-exists-p w32 #'w32-selection-exists-p) (when (eq system-type 'windows-nt) ;; Make copy&pasting in w32's console interact with the system's clipboard! - (gui-method-define gui-select-text t #'w32--select-text) - (gui-method-define gui-selection-value t #'w32--get-selection-value)) - -;;; Fix interface to (X-specific) mouse.el -(gui-method-define gui-own-selection w32 - (lambda (type value) - (put 'x-selections (or type 'PRIMARY) data))) - -(gui-method-define gui-disown-selection w32 - (lambda (type) - (put 'x-selections (or type 'PRIMARY) nil))) - -(gui-method-define gui-get-selection w32 - (lambda (&optional type _data-type) - (get 'x-selections (or type 'PRIMARY)))) - -;; gui-selection-owner-p is used in simple.el -(gui-method-define gui-selection-owner-p w32 - (lambda (selection) - (and (memq selection '(nil PRIMARY SECONDARY)) - (get 'x-selections (or selection 'PRIMARY))))) -(gui-method-define gui-selection-exists-p w32 #'x-selection-exists-p) + (gui-method-define gui-set-selection nil #'w32--set-selection) + (gui-method-define gui-get-selection nil #'w32--get-selection) + (gui-method-define gui-selection-owner-p nil #'w32--selection-owner-p) + (gui-method-define gui-selection-exists-p nil #'w32-selection-exists-p)) ;; The "Windows" keys on newer keyboards bring up the Start menu ;; whether you want it or not - make Emacs ignore these keystrokes === modified file 'lisp/term/x-win.el' --- lisp/term/x-win.el 2014-10-18 16:19:53 +0000 +++ lisp/term/x-win.el 2014-10-21 15:27:18 +0000 @@ -1154,136 +1154,6 @@ ;;;; Selections -;; We keep track of the last text selected here, so we can check the -;; current selection against it, and avoid passing back our own text -;; from x--selection-value. We track both -;; separately in case another X application only sets one of them -;; we aren't fooled by the PRIMARY or CLIPBOARD selection staying the same. -(defvar x-last-selected-text-clipboard nil - "The value of the CLIPBOARD X selection last time we selected or -pasted text.") -(defvar x-last-selected-text-primary nil - "The value of the PRIMARY X selection last time we selected or -pasted text.") - -(defcustom x-select-enable-primary nil - "Non-nil means cutting and pasting uses the primary selection." - :type 'boolean - :group 'killing - :version "24.1") - -(defcustom x-select-request-type nil - "Data type request for X selection. -The value is one of the following data types, a list of them, or nil: - `COMPOUND_TEXT', `UTF8_STRING', `STRING', `TEXT' - -If the value is one of the above symbols, try only the specified type. - -If the value is a list of them, try each of them in the specified -order until succeed. - -The value nil is the same as the list (UTF8_STRING COMPOUND_TEXT STRING)." - :type '(choice (const :tag "Default" nil) - (const COMPOUND_TEXT) - (const UTF8_STRING) - (const STRING) - (const TEXT) - (set :tag "List of values" - (const COMPOUND_TEXT) - (const UTF8_STRING) - (const STRING) - (const TEXT))) - :group 'killing) - -;; Get a selection value of type TYPE by calling x-get-selection with -;; an appropriate DATA-TYPE argument decided by `x-select-request-type'. -;; The return value is already decoded. If x-get-selection causes an -;; error, this function return nil. - -(defun x-selection-value-internal (type) - (let ((request-type (or x-select-request-type - '(UTF8_STRING COMPOUND_TEXT STRING))) - text) - (if (consp request-type) - (while (and request-type (not text)) - (condition-case nil - (setq text (x-get-selection type (car request-type))) - (error nil)) - (setq request-type (cdr request-type))) - (condition-case nil - (setq text (x-get-selection type request-type)) - (error nil))) - (if text - (remove-text-properties 0 (length text) '(foreign-selection nil) text)) - text)) - -;; Return the value of the current X selection. -;; Consult the selection. Treat empty strings as if they were unset. -;; If this function is called twice and finds the same text, -;; it returns nil the second time. This is so that a single -;; selection won't be added to the kill ring over and over. -(gui-method-define gui-selection-value x #'x--selection-value) -(defun x--selection-value () - ;; With multi-tty, this function may be called from a tty frame. - (let (clip-text primary-text) - (when x-select-enable-clipboard - (setq clip-text (x-selection-value-internal 'CLIPBOARD)) - (if (string= clip-text "") (setq clip-text nil)) - - ;; Check the CLIPBOARD selection for 'newness', is it different - ;; from what we remembered them to be last time we did a - ;; cut/paste operation. - (setq clip-text - (cond ;; check clipboard - ((or (not clip-text) (string= clip-text "")) - (setq x-last-selected-text-clipboard nil)) - ((eq clip-text x-last-selected-text-clipboard) nil) - ((string= clip-text x-last-selected-text-clipboard) - ;; Record the newer string, - ;; so subsequent calls can use the `eq' test. - (setq x-last-selected-text-clipboard clip-text) - nil) - (t (setq x-last-selected-text-clipboard clip-text))))) - - (when x-select-enable-primary - (setq primary-text (x-selection-value-internal 'PRIMARY)) - ;; Check the PRIMARY selection for 'newness', is it different - ;; from what we remembered them to be last time we did a - ;; cut/paste operation. - (setq primary-text - (cond ;; check primary selection - ((or (not primary-text) (string= primary-text "")) - (setq x-last-selected-text-primary nil)) - ((eq primary-text x-last-selected-text-primary) nil) - ((string= primary-text x-last-selected-text-primary) - ;; Record the newer string, - ;; so subsequent calls can use the `eq' test. - (setq x-last-selected-text-primary primary-text) - nil) - (t - (setq x-last-selected-text-primary primary-text))))) - - ;; As we have done one selection, clear this now. - (setq next-selection-coding-system nil) - - ;; At this point we have recorded the current values for the - ;; selection from clipboard (if we are supposed to) and primary. - ;; So return the first one that has changed - ;; (which is the first non-null one). - ;; - ;; NOTE: There will be cases where more than one of these has - ;; changed and the new values differ. This indicates that - ;; something like the following has happened since the last time - ;; we looked at the selections: Application X set all the - ;; selections, then Application Y set only one of them. - ;; In this case since we don't have - ;; timestamps there is no way to know what the 'correct' value to - ;; return is. The nice thing to do would be to tell the user we - ;; saw multiple possible selections and ask the user which was the - ;; one they wanted. - (or clip-text primary-text) - )) - (define-obsolete-function-alias 'x-cut-buffer-or-selection-value 'x-selection-value "24.1") @@ -1457,21 +1327,10 @@ (gui-method-define frame-creation-function x #'x-create-frame-with-faces) (gui-method-define window-system-initialization x #'x-initialize-window-system) -(defvar x-select-enable-primary) ; x-win.el -(gui-method-define gui-select-text x - (lambda (text) - (when x-select-enable-primary - (gui-set-selection 'PRIMARY text) - (setq x-last-selected-text-primary text)) - (when x-select-enable-clipboard - ;; When cutting, the selection is cleared and PRIMARY - ;; set to the empty string. Prevent that, PRIMARY - ;; should not be reset by cut (Bug#16382). - (setq saved-region-selection text) - (gui-set-selection 'CLIPBOARD text) - (setq x-last-selected-text-clipboard text)))) -(gui-method-define gui-own-selection x #'x-own-selection-internal) -(gui-method-define gui-disown-selection x #'x-disown-selection-internal) +(gui-method-define gui-set-selection x + (lambda (selection value) + (if value (x-own-selection-internal selection value) + (x-disown-selection-internal selection)))) (gui-method-define gui-selection-owner-p x #'x-selection-owner-p) (gui-method-define gui-selection-exists-p x #'x-selection-exists-p) (gui-method-define gui-get-selection x #'x-get-selection-internal) === modified file 'src/ChangeLog' --- src/ChangeLog 2014-10-21 06:57:28 +0000 +++ src/ChangeLog 2014-10-21 15:27:18 +0000 @@ -1,3 +1,21 @@ +2014-10-21 Stefan Monnier + + * w32select.c (Fw32_selection_exists_p): Rename from + Fx_selection_exists_p. + (syms_of_w32select): Adjust accordingly. + + * w16select.c (Fw16_selection_exists_p): Rename from + Fx_selection_exists_p. + (syms_of_win16select): Adjust accordingly. + + * nsselect.m (ns_get_local_selection): Signal error rather than `quit'. + (Fns_own_selection_internal): Tighten scoping. + (Fns_selection_exists_p): Rename from Fx_selection_exists_p. + (Fns_get_selection): Rename from Fx_get_selection_internal. + (Fns_get_selection_internal, Fns_store_selection_internal): + Remove functions. + (syms_of_nsselect): Adjust accordingly. + 2014-10-21 Martin Rudalics * w32fns.c (Fw32_frame_menu_bar_size): New function. === modified file 'src/nsselect.m' --- src/nsselect.m 2014-10-02 03:19:32 +0000 +++ src/nsselect.m 2014-10-21 15:27:18 +0000 @@ -26,7 +26,7 @@ */ /* This should be the first include, as it may set up #defines affecting - interpretation of even the system includes. */ + interpretation of even the system includes. */ #include #include "lisp.h" @@ -161,8 +161,10 @@ length: SBYTES (str) encoding: NSUTF8StringEncoding freeWhenDone: NO]; + // FIXME: Why those 2 different code paths? if (gtype == nil) { + // Used for ns-store-selection-internal. [pb declareTypes: ns_send_types owner: nil]; tenum = [ns_send_types objectEnumerator]; while ( (type = [tenum nextObject]) ) @@ -170,6 +172,8 @@ } else { + // Used for ns-own-selection-internal. + eassert (type == NSStringPboardType); [pb setString: nsStr forType: gtype]; } [nsStr release]; @@ -183,13 +187,12 @@ { Lisp_Object local_value; Lisp_Object handler_fn, value, check; - ptrdiff_t count; + ptrdiff_t count = specpdl_ptr - specpdl; local_value = assq_no_quit (selection_name, Vselection_alist); if (NILP (local_value)) return Qnil; - count = specpdl_ptr - specpdl; specbind (Qinhibit_quit, Qt); CHECK_SYMBOL (target_type); handler_fn = Fcdr (Fassq (target_type, Vselection_converter_alist)); @@ -212,19 +215,16 @@ if (CONSP (check) && INTEGERP (XCAR (check)) - && (INTEGERP (XCDR (check))|| - (CONSP (XCDR (check)) - && INTEGERP (XCAR (XCDR (check))) - && NILP (XCDR (XCDR (check)))))) + && (INTEGERP (XCDR (check)) + || (CONSP (XCDR (check)) + && INTEGERP (XCAR (XCDR (check))) + && NILP (XCDR (XCDR (check)))))) return value; - // FIXME: Why `quit' rather than `error'? - Fsignal (Qquit, + Fsignal (Qerror, list3 (build_string ("invalid data returned by" " selection-conversion function"), handler_fn, value)); - // FIXME: Beware, `quit' can return!! - return Qnil; } @@ -338,7 +338,6 @@ (Lisp_Object selection, Lisp_Object value) { id pb; - Lisp_Object old_value, new_value; NSString *type; Lisp_Object successful_p = Qnil, rest; Lisp_Object target_symbol, data; @@ -351,13 +350,15 @@ if (pb == nil) return Qnil; ns_declare_pasteboard (pb); - old_value = assq_no_quit (selection, Vselection_alist); - new_value = list2 (selection, value); + { + Lisp_Object old_value = assq_no_quit (selection, Vselection_alist); + Lisp_Object new_value = list2 (selection, value); - if (NILP (old_value)) - Vselection_alist = Fcons (new_value, Vselection_alist); - else - Fsetcdr (old_value, Fcdr (new_value)); + if (NILP (old_value)) + Vselection_alist = Fcons (new_value, Vselection_alist); + else + Fsetcdr (old_value, Fcdr (new_value)); + } /* We only support copy of text. */ type = NSStringPboardType; @@ -372,6 +373,7 @@ if (!EQ (Vns_sent_selection_hooks, Qunbound)) { + /* FIXME: Use run-hook-with-args! */ for (rest = Vns_sent_selection_hooks; CONSP (rest); rest = Fcdr (rest)) call3 (Fcar (rest), selection, target_symbol, successful_p); } @@ -397,7 +399,7 @@ } -DEFUN ("x-selection-exists-p", Fx_selection_exists_p, Sx_selection_exists_p, +DEFUN ("ns-selection-exists-p", Fns_selection_exists_p, Sns_selection_exists_p, 0, 2, 0, doc: /* Whether there is an owner for the given X selection. SELECTION should be the name of the selection in question, typically one of the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'. (X expects @@ -452,8 +454,8 @@ } -DEFUN ("x-get-selection-internal", Fx_get_selection_internal, - Sx_get_selection_internal, 2, 4, 0, +DEFUN ("ns-get-selection", Fns_get_selection, + Sns_get_selection, 2, 4, 0, doc: /* Return text selected from some X window. SELECTION-SYMBOL is typically `PRIMARY', `SECONDARY', or `CLIPBOARD'. \(Those are literal upper-case symbol names, since that's what X expects.) @@ -489,33 +491,6 @@ } -DEFUN ("ns-get-selection-internal", Fns_get_selection_internal, - Sns_get_selection_internal, 1, 1, 0, - doc: /* Returns the value of SELECTION as a string. -SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'. */) - (Lisp_Object selection) -{ - id pb; - check_window_system (NULL); - pb = ns_symbol_to_pb (selection); - return pb != nil ? ns_string_from_pasteboard (pb) : Qnil; -} - - -DEFUN ("ns-store-selection-internal", Fns_store_selection_internal, - Sns_store_selection_internal, 2, 2, 0, - doc: /* Sets the string value of SELECTION. -SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'. */) - (Lisp_Object selection, Lisp_Object string) -{ - id pb; - check_window_system (NULL); - pb = ns_symbol_to_pb (selection); - if (pb != nil) ns_string_to_pasteboard (pb, string); - return Qnil; -} - - void nxatoms_of_nsselect (void) { @@ -532,12 +507,10 @@ QFILE_NAME = intern_c_string ("FILE_NAME"); staticpro (&QFILE_NAME); defsubr (&Sns_disown_selection_internal); - defsubr (&Sx_get_selection_internal); + defsubr (&Sns_get_selection); defsubr (&Sns_own_selection_internal); - defsubr (&Sx_selection_exists_p); + defsubr (&Sns_selection_exists_p); defsubr (&Sns_selection_owner_p); - defsubr (&Sns_get_selection_internal); - defsubr (&Sns_store_selection_internal); Vselection_alist = Qnil; staticpro (&Vselection_alist); === modified file 'src/w16select.c' --- src/w16select.c 2014-07-17 15:40:18 +0000 +++ src/w16select.c 2014-10-21 15:27:18 +0000 @@ -625,9 +625,9 @@ return (ret); } -/* Support checking for a clipboard selection. */ +/* Support checking for a clipboard selection. */ -DEFUN ("x-selection-exists-p", Fx_selection_exists_p, Sx_selection_exists_p, +DEFUN ("w16-selection-exists-p", Fw16_selection_exists_p, Sw16_selection_exists_p, 0, 2, 0, doc: /* Whether there is an owner for the given X selection. SELECTION should be the name of the selection in question, typically @@ -677,7 +677,7 @@ { defsubr (&Sw16_set_clipboard_data); defsubr (&Sw16_get_clipboard_data); - defsubr (&Sx_selection_exists_p); + defsubr (&Sw16_selection_exists_p); DEFVAR_LISP ("selection-coding-system", Vselection_coding_system, doc: /* Coding system for communicating with other programs. === modified file 'src/w32select.c' --- src/w32select.c 2014-10-18 12:47:57 +0000 +++ src/w32select.c 2014-10-21 15:27:18 +0000 @@ -1013,9 +1013,9 @@ return (ret); } -/* Support checking for a clipboard selection. */ +/* Support checking for a clipboard selection. */ -DEFUN ("x-selection-exists-p", Fx_selection_exists_p, Sx_selection_exists_p, +DEFUN ("w32-selection-exists-p", Fw32_selection_exists_p, Sw32_selection_exists_p, 0, 2, 0, doc: /* Whether there is an owner for the given X selection. SELECTION should be the name of the selection in question, typically @@ -1031,7 +1031,7 @@ CHECK_SYMBOL (selection); /* Return nil for PRIMARY and SECONDARY selections; for CLIPBOARD, check - if the clipboard currently has valid text format contents. */ + if the clipboard currently has valid text format contents. */ if (EQ (selection, QCLIPBOARD)) { @@ -1060,14 +1060,14 @@ } /* One-time init. Called in the un-dumped Emacs, but not in the - dumped version. */ + dumped version. */ void syms_of_w32select (void) { defsubr (&Sw32_set_clipboard_data); defsubr (&Sw32_get_clipboard_data); - defsubr (&Sx_selection_exists_p); + defsubr (&Sw32_selection_exists_p); DEFVAR_LISP ("selection-coding-system", Vselection_coding_system, doc: /* Coding system for communicating with other programs. ------------------------------------------------------------ revno: 118172 committer: martin rudalics branch nick: trunk timestamp: Tue 2014-10-21 08:57:28 +0200 message: Handle wrapped menu bar lines when resizing frames with Windows API. * w32fns.c (Fw32_frame_menu_bar_size): New function. * w32term.c (x_set_window_size): Account for wrapped menu bar lines when setting up frame height (Bug#15174 and Bug#18720). (w32_add_wrapped_menu_bar_lines): New variable. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2014-10-21 01:17:06 +0000 +++ src/ChangeLog 2014-10-21 06:57:28 +0000 @@ -1,3 +1,10 @@ +2014-10-21 Martin Rudalics + + * w32fns.c (Fw32_frame_menu_bar_size): New function. + * w32term.c (x_set_window_size): Account for wrapped menu bar + lines when setting up frame height (Bug#15174 and Bug#18720). + (w32_add_wrapped_menu_bar_lines): New variable. + 2014-10-21 Stefan Monnier * xdisp.c (redisplay_window): Re-run pre-redisplay-function after we === modified file 'src/w32fns.c' --- src/w32fns.c 2014-10-14 12:45:41 +0000 +++ src/w32fns.c 2014-10-21 06:57:28 +0000 @@ -7366,6 +7366,34 @@ return Qt; } +DEFUN ("w32-frame-menu-bar-size", Fw32_frame_menu_bar_size, Sw32_frame_menu_bar_size, 0, 1, 0, + doc: /* Return sizes of menu bar on frame FRAME. +The return value is a list of three elements: The current width and +height of FRAME's menu bar in pixels and the default height of the menu +bar in pixels. If FRAME is omitted or nil, the selected frame is +used. */) + (Lisp_Object frame) +{ + struct frame *f = decode_any_frame (frame); + MENUBARINFO info; + int width, height, default_height; + + block_input (); + + default_height = GetSystemMetrics (SM_CYMENUSIZE); + info.cbSize = sizeof (info); + info.rcBar.right = info.rcBar.left = 0; + info.rcBar.top = info.rcBar.bottom = 0; + GetMenuBarInfo (FRAME_W32_WINDOW (f), 0xFFFFFFFD, 0, &info); + width = info.rcBar.right - info.rcBar.left; + height = info.rcBar.bottom - info.rcBar.top; + + unblock_input (); + + return list3 (make_number (width), make_number (height), + make_number (default_height)); +} + DEFUN ("w32-frame-rect", Fw32_frame_rect, Sw32_frame_rect, 0, 2, 0, doc: /* Return boundary rectangle of FRAME in screen coordinates. FRAME must be a live frame and defaults to the selected one. @@ -8399,6 +8427,7 @@ defsubr (&Sw32_toggle_lock_key); defsubr (&Sw32_window_exists_p); defsubr (&Sw32_frame_rect); + defsubr (&Sw32_frame_menu_bar_size); defsubr (&Sw32_battery_status); #ifdef WINDOWSNT === modified file 'src/w32term.c' --- src/w32term.c 2014-10-09 04:23:09 +0000 +++ src/w32term.c 2014-10-21 06:57:28 +0000 @@ -6119,6 +6119,30 @@ pixelheight = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, height); } + if (w32_add_wrapped_menu_bar_lines) + { + /* When the menu bar wraps sending a SetWindowPos shrinks the + height of the frame when the wrapped menu bar lines are not + accounted for (Bug#15174 and Bug#18720). Here we add these + extra lines to the frame height. */ + MENUBARINFO info; + int default_menu_bar_height; + int menu_bar_height; + + /* Why is (apparently) SM_CYMENUSIZE needed here instead of + SM_CYMENU ?? */ + default_menu_bar_height = GetSystemMetrics (SM_CYMENUSIZE); + info.cbSize = sizeof (info); + info.rcBar.top = info.rcBar.bottom = 0; + GetMenuBarInfo (FRAME_W32_WINDOW (f), 0xFFFFFFFD, 0, &info); + menu_bar_height = info.rcBar.bottom - info.rcBar.top; + + if ((default_menu_bar_height > 0) + && (menu_bar_height > default_menu_bar_height) + && ((menu_bar_height % default_menu_bar_height) == 0)) + pixelheight = pixelheight + menu_bar_height - default_menu_bar_height; + } + f->win_gravity = NorthWestGravity; x_wm_set_size_hint (f, (long) 0, 0); @@ -7080,6 +7104,21 @@ Windows 8. It is set to nil on Windows 9X. */); w32_unicode_filenames = 0; + + /* FIXME: The following two variables will be (hopefully) removed + before Emacs 25.1 gets released. */ + + DEFVAR_BOOL ("w32-add-wrapped-menu-bar-lines", + w32_add_wrapped_menu_bar_lines, + doc: /* Non-nil means frame resizing accounts for wrapped menu bar lines. +A value of nil means frame resizing does not add the height of wrapped +menu bar lines when sending a frame resize request to the Windows API. +This usually means that the resulting frame height is off by the number +of wrapped menu bar lines. If this is non-nil, Emacs adds the height of +wrapped menu bar lines when sending frame resize requests to the Windows +API. */); + w32_add_wrapped_menu_bar_lines = 1; + DEFVAR_BOOL ("w32-enable-frame-resize-hack", w32_enable_frame_resize_hack, doc: /* Non-nil means enable hack for frame resizing on Windows. ------------------------------------------------------------ Use --include-merged or -n0 to see merged revisions.