commit 8f0376309ee37e4f1da21d78971c4df2df5fd7b6 (HEAD, refs/remotes/origin/master) Author: Stefan Monnier Date: Thu Jan 5 21:02:48 2017 -0500 (feedmail-deduce-address-list): Avoid add-to-list on local variables. Author: * lisp/mail/feedmail.el (feedmail-deduce-address-list): Avoid add-to-list on local variables. diff --git a/lisp/mail/feedmail.el b/lisp/mail/feedmail.el index eed664d088..1402db4095 100644 --- a/lisp/mail/feedmail.el +++ b/lisp/mail/feedmail.el @@ -3147,7 +3147,7 @@ been weeded out." (setq simple-address (substring address-blob (match-beginning 2) (match-end 2))) (setq address-blob (replace-match "" t t address-blob)) (if (not (member simple-address address-list)) - (add-to-list 'address-list simple-address))) + (push simple-address address-list))) )) (kill-buffer nil))) (identity address-list))) commit 69b9224a327ade40f3dab9b8ae6d9553462ced07 Author: Noam Postavsky Date: Sat Dec 31 00:31:49 2016 -0500 Fix isearch handling of C-u C-u... * lisp/isearch.el: Add `isearch-scroll' property to universal-argument-more so that `isearch-allow-scroll' will apply to it as well. (isearch-pre-command-hook): Let `isearch-allow-prefix' apply to `universal-argument-more' as well (Bug#25302). diff --git a/lisp/isearch.el b/lisp/isearch.el index b890cc49c0..5c48c30daa 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -2297,6 +2297,7 @@ to the barrier." ;; Universal argument commands (put 'universal-argument 'isearch-scroll t) +(put 'universal-argument-more 'isearch-scroll t) (put 'negative-argument 'isearch-scroll t) (put 'digit-argument 'isearch-scroll t) @@ -2389,7 +2390,7 @@ before the command is executed globally with terminated Isearch." (setq this-command 'isearch-edit-string)) ;; Handle a scrolling function or prefix argument. ((or (and isearch-allow-prefix - (memq this-command '(universal-argument + (memq this-command '(universal-argument universal-argument-more digit-argument negative-argument))) (and isearch-allow-scroll (symbolp this-command) commit d1d9b376306edb77632968cbbd7dfa456f00046c Author: Paul Eggert Date: Thu Jan 5 12:04:00 2017 -0800 Shorten autogen.sh script * autogen.sh: Use a shorter script, as some 'sed' implementations mishandle long scripts. diff --git a/autogen.sh b/autogen.sh index e5b3eadf33..2021c771fc 100755 --- a/autogen.sh +++ b/autogen.sh @@ -224,8 +224,8 @@ Please report any problems with this script to bug-gnu-emacs@gnu.org .' ## Create nt/gnulib.mk if it doesn't exist, as autoreconf will need it. if test ! -f nt/gnulib.mk; then echo 'Inferring nt/gnulib.mk from lib/gnulib.mk ...' - metascript='/^[^#]/s|^.*$|/^## begin *gnulib module &/,/^## end *gnulib module &/d|' - script=`sed "$metascript" nt/gnulib-modules-to-delete.cfg` || exit + metascript='/^[^#]/s|^.*$|/^## begin *gnulib module &/,/^## end *gnulib module &/d|p' + script=`sed -n "$metascript" nt/gnulib-modules-to-delete.cfg` || exit sed "$script" lib/gnulib.mk > nt/gnulib.mk || exit fi commit ade6a024c80dbb0b66d9d2e10ccd350618036e78 Author: Eli Zaretskii Date: Thu Jan 5 21:36:58 2017 +0200 Yet another fix for autogen.sh * autogen.sh (gnulib.mk): Make the Sed script more portable. * nt/Makefile.in (${srcdir}/gnulib.mk): Adapt the Sed command to the changes in autogen.sh. diff --git a/autogen.sh b/autogen.sh index 47e518ccf6..e5b3eadf33 100755 --- a/autogen.sh +++ b/autogen.sh @@ -224,10 +224,8 @@ Please report any problems with this script to bug-gnu-emacs@gnu.org .' ## Create nt/gnulib.mk if it doesn't exist, as autoreconf will need it. if test ! -f nt/gnulib.mk; then echo 'Inferring nt/gnulib.mk from lib/gnulib.mk ...' - echo '/^[^#]/s|^.*$|/^## begin *gnulib module &/,/^## end *gnulib module &/c\\\' > metascript.$$ - echo '## gnulib module & removed|' >> metascript.$$ - script=`sed -f metascript.$$ nt/gnulib-modules-to-delete.cfg` || exit - rm -f metascript.$$ + metascript='/^[^#]/s|^.*$|/^## begin *gnulib module &/,/^## end *gnulib module &/d|' + script=`sed "$metascript" nt/gnulib-modules-to-delete.cfg` || exit sed "$script" lib/gnulib.mk > nt/gnulib.mk || exit fi diff --git a/nt/Makefile.in b/nt/Makefile.in index 89f44606d7..34c552ca26 100644 --- a/nt/Makefile.in +++ b/nt/Makefile.in @@ -262,6 +262,6 @@ emacs.res ../src/emacs.res: emacs.rc ${srcdir}/icons/emacs.ico \ $(AM_V_RC)${WINDRES} -I ${srcdir} -O coff -o $@ $< ${srcdir}/gnulib.mk: ${srcdir}/gnulib-modules-to-delete.cfg ${srcdir}/../lib/gnulib.mk - $(AM_V_GEN)sed '/^[^#]/s|^.*$$|/^## begin *gnulib module &/,/^## end *gnulib module &/c ## gnulib module & removed|' < $< | \ + $(AM_V_GEN)sed '/^[^#]/s|^.*$$|/^## begin *gnulib module &/,/^## end *gnulib module &/d|' < $< | \ sed -f- ${srcdir}/../lib/gnulib.mk > $@-t && \ ${srcdir}/../build-aux/move-if-change $@-t $@ commit 99af58d74e431da6b55f21272bf72a9f56ce0900 Author: Eli Zaretskii Date: Thu Jan 5 19:48:49 2017 +0200 * autogen.sh (gnulib.mk): Another attempt to fix macOS build. diff --git a/autogen.sh b/autogen.sh index 1ba925380c..47e518ccf6 100755 --- a/autogen.sh +++ b/autogen.sh @@ -224,8 +224,10 @@ Please report any problems with this script to bug-gnu-emacs@gnu.org .' ## Create nt/gnulib.mk if it doesn't exist, as autoreconf will need it. if test ! -f nt/gnulib.mk; then echo 'Inferring nt/gnulib.mk from lib/gnulib.mk ...' - metascript='/^[^#]/s|^.*$|/^## begin *gnulib module &/,/^## end *gnulib module &/c\\\'\n'## gnulib module & removed|' - script=`sed "$metascript" nt/gnulib-modules-to-delete.cfg` || exit + echo '/^[^#]/s|^.*$|/^## begin *gnulib module &/,/^## end *gnulib module &/c\\\' > metascript.$$ + echo '## gnulib module & removed|' >> metascript.$$ + script=`sed -f metascript.$$ nt/gnulib-modules-to-delete.cfg` || exit + rm -f metascript.$$ sed "$script" lib/gnulib.mk > nt/gnulib.mk || exit fi commit 003954e67fbe97c6ac786983912f572c48a331f5 Author: Eli Zaretskii Date: Thu Jan 5 18:04:54 2017 +0200 Fix dependencies of nt/gnulib.mk * Makefile.in ($(srcdir)/nt/gnulib.mk): Avoid circular dependency of nt/gnulib.mk on lib/Makefile.in. diff --git a/Makefile.in b/Makefile.in index b9aaf5babc..0ecb273fb2 100644 --- a/Makefile.in +++ b/Makefile.in @@ -458,7 +458,7 @@ AUTOMAKE_INPUTS = $(srcdir)/aclocal.m4 $(srcdir)/lib/Makefile.am \ $(srcdir)/lib/Makefile.in: $(AUTOMAKE_INPUTS) cd $(srcdir) && $(AUTOMAKE) --gnu -a -c lib/Makefile -$(srcdir)/nt/gnulib.mk: $(srcdir)/lib/Makefile.in +$(srcdir)/nt/gnulib.mk: $(srcdir)/lib/gnulib.mk $(MAKE) -C $(srcdir)/nt gnulib.mk # Regenerate files that this makefile would have made, if this makefile commit b5f157e935ce670173126409c3ee79c52ab8745a Author: Eli Zaretskii Date: Thu Jan 5 17:55:43 2017 +0200 Unbreak macOS build * autogen.sh (gnulib.mk): Don't use non-portable extensions of GNU Sed. diff --git a/autogen.sh b/autogen.sh index f6bfde6afb..1ba925380c 100755 --- a/autogen.sh +++ b/autogen.sh @@ -224,7 +224,7 @@ Please report any problems with this script to bug-gnu-emacs@gnu.org .' ## Create nt/gnulib.mk if it doesn't exist, as autoreconf will need it. if test ! -f nt/gnulib.mk; then echo 'Inferring nt/gnulib.mk from lib/gnulib.mk ...' - metascript='/^[^#]/s|^.*$|/^## begin *gnulib module &/,/^## end *gnulib module &/c ## gnulib module & removed|' + metascript='/^[^#]/s|^.*$|/^## begin *gnulib module &/,/^## end *gnulib module &/c\\\'\n'## gnulib module & removed|' script=`sed "$metascript" nt/gnulib-modules-to-delete.cfg` || exit sed "$script" lib/gnulib.mk > nt/gnulib.mk || exit fi commit d88cdad2847726438c7d1de9fd2651c4be9243aa Author: Johan Claesson Date: Wed Dec 28 12:56:11 2016 -0500 Fix term.el handling of ^Z-sequences spanning chunks Bash will after each command send ?\032 and the current directory "/tmp" to inform term.el. Bash output is buffered in 4096 bytes chunks. If a command outputs roughly 4096 bytes then the end of the first chunk will be "/tm" (Bug#13350). * lisp/term.el (term-emulate-terminal): Change the regexp to find the end of the ?\032 sequence to use \n instead of $, the latter can match end of string as well. Copyright-paperwork-exempt: yes diff --git a/lisp/term.el b/lisp/term.el index a3933ae4a4..5259571eb6 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -2903,12 +2903,12 @@ See `term-prompt-regexp'." (beep t)) ((and (eq char ?\032) (not handled-ansi-message)) - (let ((end (string-match "\r?$" str i))) + (let ((end (string-match "\r?\n" str i))) (if end (funcall term-command-hook (decode-coding-string (prog1 (substring str (1+ i) end) - (setq i (match-end 0))) + (setq i (1- (match-end 0)))) locale-coding-system)) (setq term-terminal-parameter (substring str i)) (setq term-terminal-state 4) commit 0392f942c787f1a42b3e5d9516a447687ed3baef Author: Mark Oteiza Date: Wed Jan 4 22:31:26 2017 -0500 Turn on lexical-binding in mb-depth.el * lisp/mb-depth.el: Turn on lexical-binding. (minibuffer-depth-setup): Bind things used multiple times. diff --git a/lisp/mb-depth.el b/lisp/mb-depth.el index a16557b063..57fe7abde5 100644 --- a/lisp/mb-depth.el +++ b/lisp/mb-depth.el @@ -1,4 +1,4 @@ -;;; mb-depth.el --- Indicate minibuffer-depth in prompt +;;; mb-depth.el --- Indicate minibuffer-depth in prompt -*- lexical-binding: t -*- ;; ;; Copyright (C) 2006-2017 Free Software Foundation, Inc. ;; @@ -45,13 +45,15 @@ and must return a string.") (defun minibuffer-depth-setup () "Set up a minibuffer for `minibuffer-depth-indicate-mode'. The prompt should already have been inserted." - (when (> (minibuffer-depth) 1) - (setq minibuffer-depth-overlay (make-overlay (point-min) (1+ (point-min)))) - (overlay-put minibuffer-depth-overlay 'before-string - (if minibuffer-depth-indicator-function - (funcall minibuffer-depth-indicator-function (minibuffer-depth)) - (propertize (format "[%d]" (minibuffer-depth)) 'face 'highlight))) - (overlay-put minibuffer-depth-overlay 'evaporate t))) + (let ((depth (minibuffer-depth))) + (when (> depth 1) + (let ((pos (point-min))) + (setq minibuffer-depth-overlay (make-overlay pos (1+ pos)))) + (overlay-put minibuffer-depth-overlay 'before-string + (if minibuffer-depth-indicator-function + (funcall minibuffer-depth-indicator-function depth) + (propertize (format "[%d]" depth) 'face 'highlight))) + (overlay-put minibuffer-depth-overlay 'evaporate t)))) ;;;###autoload (define-minor-mode minibuffer-depth-indicate-mode commit 308d5962236448a84795f49d775601599688d78d Author: Alan Third Date: Wed Jan 4 12:41:29 2017 +0000 Revert "Rework NS event handling (bug#25265)" This reverts commit e0e5b0f4a4ce1d19ee0240c514dedd873d4165dc. diff --git a/src/nsterm.h b/src/nsterm.h index 161c3c2964..534ec68c22 100644 --- a/src/nsterm.h +++ b/src/nsterm.h @@ -392,6 +392,7 @@ char const * nstrace_fullscreen_type_name (int); - (void)sendEvent: (NSEvent *)theEvent; - (void)showPreferencesWindow: (id)sender; - (BOOL) openFile: (NSString *)fileName; +- (void)fd_handler: (id)unused; - (void)timeout_handler: (NSTimer *)timedEntry; - (BOOL)fulfillService: (NSString *)name withArg: (NSString *)arg; #ifdef NS_IMPL_GNUSTEP diff --git a/src/nsterm.m b/src/nsterm.m index 1d038cdcb0..47fc6c18ac 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -279,10 +279,18 @@ - (NSColor *)colorUsingDefaultColorSpace /*static int debug_lock = 0; */ /* event loop */ +static BOOL send_appdefined = YES; #define NO_APPDEFINED_DATA (-8) static int last_appdefined_event_data = NO_APPDEFINED_DATA; static NSTimer *timed_entry = 0; static NSTimer *scroll_repeat_entry = nil; +static fd_set select_readfds, select_writefds; +enum { SELECT_HAVE_READ = 1, SELECT_HAVE_WRITE = 2, SELECT_HAVE_TMO = 4 }; +static int select_nfds = 0, select_valid = 0; +static struct timespec select_timeout = { 0, 0 }; +static int selfds[2] = { -1, -1 }; +static pthread_mutex_t select_mutex; +static int apploopnr = 0; static NSAutoreleasePool *outerpool; static struct input_event *emacs_event = NULL; static struct input_event *q_event_ptr = NULL; @@ -449,6 +457,7 @@ - (NSColor *)colorUsingDefaultColorSpace hold_event_q.q[hold_event_q.nr++] = *event; /* Make sure ns_read_socket is called, i.e. we have input. */ raise (SIGIO); + send_appdefined = YES; } static Lisp_Object @@ -3863,17 +3872,31 @@ overwriting cursor (usually when cursor on a tab) */ return; } - /* Only post this event if we haven't already posted one. This will - end the [NXApp run] main loop after having processed all events - queued at this moment. */ - NSEvent *appev = [NSApp nextEventMatchingMask:NSEventMaskApplicationDefined - untilDate:[NSDate distantPast] - inMode:NSDefaultRunLoopMode - dequeue:NO]; - if (! appev) + /* Only post this event if we haven't already posted one. This will end + the [NXApp run] main loop after having processed all events queued at + this moment. */ + +#ifdef NS_IMPL_COCOA + if (! send_appdefined) + { + /* OS X 10.10.1 swallows the AppDefined event we are sending ourselves + in certain situations (rapid incoming events). + So check if we have one, if not add one. */ + NSEvent *appev = [NSApp nextEventMatchingMask:NSEventMaskApplicationDefined + untilDate:[NSDate distantPast] + inMode:NSDefaultRunLoopMode + dequeue:NO]; + if (! appev) send_appdefined = YES; + } +#endif + + if (send_appdefined) { NSEvent *nxev; + /* We only need one NX_APPDEFINED event to stop NXApp from running. */ + send_appdefined = NO; + /* Don't need wakeup timer any more */ if (timed_entry) { @@ -3988,6 +4011,14 @@ overwriting cursor (usually when cursor on a tab) */ } #endif /* NS_IMPL_COCOA */ +static void +unwind_apploopnr (Lisp_Object not_used) +{ + --apploopnr; + n_emacs_events_pending = 0; + ns_finish_events (); + q_event_ptr = NULL; +} static int ns_read_socket (struct terminal *terminal, struct input_event *hold_quit) @@ -3998,10 +4029,13 @@ overwriting cursor (usually when cursor on a tab) */ -------------------------------------------------------------------------- */ { struct input_event ev; - int nevents = 0; + int nevents; NSTRACE_WHEN (NSTRACE_GROUP_EVENTS, "ns_read_socket"); + if (apploopnr > 0) + return -1; /* Already within event loop. */ + #ifdef HAVE_NATIVE_FS check_native_fs (); #endif @@ -4018,50 +4052,55 @@ overwriting cursor (usually when cursor on a tab) */ return i; } - if ([NSThread isMainThread]) + block_input (); + n_emacs_events_pending = 0; + ns_init_events (&ev); + q_event_ptr = hold_quit; + + /* we manage autorelease pools by allocate/reallocate each time around + the loop; strict nesting is occasionally violated but seems not to + matter.. earlier methods using full nesting caused major memory leaks */ + [outerpool release]; + outerpool = [[NSAutoreleasePool alloc] init]; + + /* If have pending open-file requests, attend to the next one of those. */ + if (ns_pending_files && [ns_pending_files count] != 0 + && [(EmacsApp *)NSApp openFile: [ns_pending_files objectAtIndex: 0]]) { - block_input (); - n_emacs_events_pending = 0; - ns_init_events (&ev); - q_event_ptr = hold_quit; - - /* we manage autorelease pools by allocate/reallocate each time around - the loop; strict nesting is occasionally violated but seems not to - matter.. earlier methods using full nesting caused major memory leaks */ - [outerpool release]; - outerpool = [[NSAutoreleasePool alloc] init]; - - /* If have pending open-file requests, attend to the next one of those. */ - if (ns_pending_files && [ns_pending_files count] != 0 - && [(EmacsApp *)NSApp openFile: [ns_pending_files objectAtIndex: 0]]) - { - [ns_pending_files removeObjectAtIndex: 0]; - } - /* Deal with pending service requests. */ - else if (ns_pending_service_names && [ns_pending_service_names count] != 0 - && [(EmacsApp *) - NSApp fulfillService: [ns_pending_service_names objectAtIndex: 0] - withArg: [ns_pending_service_args objectAtIndex: 0]]) - { - [ns_pending_service_names removeObjectAtIndex: 0]; - [ns_pending_service_args removeObjectAtIndex: 0]; - } - else - { - /* Run and wait for events. We must always send one NX_APPDEFINED event - to ourself, otherwise [NXApp run] will never exit. */ - ns_send_appdefined (-1); + [ns_pending_files removeObjectAtIndex: 0]; + } + /* Deal with pending service requests. */ + else if (ns_pending_service_names && [ns_pending_service_names count] != 0 + && [(EmacsApp *) + NSApp fulfillService: [ns_pending_service_names objectAtIndex: 0] + withArg: [ns_pending_service_args objectAtIndex: 0]]) + { + [ns_pending_service_names removeObjectAtIndex: 0]; + [ns_pending_service_args removeObjectAtIndex: 0]; + } + else + { + ptrdiff_t specpdl_count = SPECPDL_INDEX (); + /* Run and wait for events. We must always send one NX_APPDEFINED event + to ourself, otherwise [NXApp run] will never exit. */ + send_appdefined = YES; + ns_send_appdefined (-1); - [NSApp run]; + if (++apploopnr != 1) + { + emacs_abort (); } - - nevents = n_emacs_events_pending; - n_emacs_events_pending = 0; - ns_finish_events (); - q_event_ptr = NULL; - unblock_input (); + record_unwind_protect (unwind_apploopnr, Qt); + [NSApp run]; + unbind_to (specpdl_count, Qnil); /* calls unwind_apploopnr */ } + nevents = n_emacs_events_pending; + n_emacs_events_pending = 0; + ns_finish_events (); + q_event_ptr = NULL; + unblock_input (); + return nevents; } @@ -4075,11 +4114,15 @@ overwriting cursor (usually when cursor on a tab) */ -------------------------------------------------------------------------- */ { int result; - NSDate *timeout_date = nil; - NSEvent *ns_event; + int t, k, nr = 0; + struct input_event event; + char c; NSTRACE_WHEN (NSTRACE_GROUP_EVENTS, "ns_select"); + if (apploopnr > 0) + return -1; /* Already within event loop. */ + #ifdef HAVE_NATIVE_FS check_native_fs (); #endif @@ -4092,34 +4135,121 @@ overwriting cursor (usually when cursor on a tab) */ return -1; } + for (k = 0; k < nfds+1; k++) + { + if (readfds && FD_ISSET(k, readfds)) ++nr; + if (writefds && FD_ISSET(k, writefds)) ++nr; + } + if (NSApp == nil - || ![NSThread isMainThread] || (timeout && timeout->tv_sec == 0 && timeout->tv_nsec == 0)) - return pselect(nfds, readfds, writefds, - exceptfds, timeout, sigmask); - - result = pselect(nfds, readfds, writefds, exceptfds, - &(struct timespec){.tv_sec = 0, .tv_nsec = 100}, - sigmask); + return pselect (nfds, readfds, writefds, exceptfds, timeout, sigmask); [outerpool release]; outerpool = [[NSAutoreleasePool alloc] init]; - if (timeout) + + send_appdefined = YES; + if (nr > 0) + { + pthread_mutex_lock (&select_mutex); + select_nfds = nfds; + select_valid = 0; + if (readfds) + { + select_readfds = *readfds; + select_valid += SELECT_HAVE_READ; + } + if (writefds) + { + select_writefds = *writefds; + select_valid += SELECT_HAVE_WRITE; + } + + if (timeout) + { + select_timeout = *timeout; + select_valid += SELECT_HAVE_TMO; + } + + pthread_mutex_unlock (&select_mutex); + + /* Inform fd_handler that select should be called */ + c = 'g'; + emacs_write_sig (selfds[1], &c, 1); + } + else if (nr == 0 && timeout) { + /* No file descriptor, just a timeout, no need to wake fd_handler */ double time = timespectod (*timeout); - timeout_date = [NSDate dateWithTimeIntervalSinceNow:time]; + timed_entry = [[NSTimer scheduledTimerWithTimeInterval: time + target: NSApp + selector: + @selector (timeout_handler:) + userInfo: 0 + repeats: NO] + retain]; + } + else /* No timeout and no file descriptors, can this happen? */ + { + /* Send appdefined so we exit from the loop */ + ns_send_appdefined (-1); + } + + block_input (); + ns_init_events (&event); + if (++apploopnr != 1) + { + emacs_abort (); } - /* Listen for a new NSEvent. */ - ns_event = [NSApp nextEventMatchingMask:NSEventMaskAny - untilDate:timeout_date - inMode:NSDefaultRunLoopMode - dequeue:NO]; + { + ptrdiff_t specpdl_count = SPECPDL_INDEX (); + record_unwind_protect (unwind_apploopnr, Qt); + [NSApp run]; + unbind_to (specpdl_count, Qnil); /* calls unwind_apploopnr */ + } - if (ns_event != nil) + ns_finish_events (); + if (nr > 0 && readfds) { - raise (SIGIO); + c = 's'; + emacs_write_sig (selfds[1], &c, 1); + } + unblock_input (); + + t = last_appdefined_event_data; + + if (t != NO_APPDEFINED_DATA) + { + last_appdefined_event_data = NO_APPDEFINED_DATA; + + if (t == -2) + { + /* The NX_APPDEFINED event we received was a timeout. */ + result = 0; + } + else if (t == -1) + { + /* The NX_APPDEFINED event we received was the result of + at least one real input event arriving. */ + errno = EINTR; + result = -1; + } + else + { + /* Received back from select () in fd_handler; copy the results */ + pthread_mutex_lock (&select_mutex); + if (readfds) *readfds = select_readfds; + if (writefds) *writefds = select_writefds; + pthread_mutex_unlock (&select_mutex); + result = t; + } + } + else + { + errno = EINTR; + result = -1; } return result; @@ -4635,6 +4765,21 @@ static Lisp_Object ns_string_to_lispmod (const char *s) baud_rate = 38400; Fset_input_interrupt_mode (Qnil); + if (selfds[0] == -1) + { + if (emacs_pipe (selfds) != 0) + { + fprintf (stderr, "Failed to create pipe: %s\n", + emacs_strerror (errno)); + emacs_abort (); + } + + fcntl (selfds[0], F_SETFL, O_NONBLOCK|fcntl (selfds[0], F_GETFL)); + FD_ZERO (&select_readfds); + FD_ZERO (&select_writefds); + pthread_mutex_init (&select_mutex, NULL); + } + ns_pending_files = [[NSMutableArray alloc] init]; ns_pending_service_names = [[NSMutableArray alloc] init]; ns_pending_service_args = [[NSMutableArray alloc] init]; @@ -4647,6 +4792,11 @@ Needs to be here because ns_initialize_display_info () uses AppKit classes. return NULL; [NSApp setDelegate: NSApp]; + /* Start the select thread. */ + [NSThread detachNewThreadSelector:@selector (fd_handler:) + toTarget:NSApp + withObject:nil]; + /* debugging: log all notifications */ /* [[NSNotificationCenter defaultCenter] addObserver: NSApp selector: @selector (logNotification:) @@ -5028,6 +5178,10 @@ - (void)sendEvent: (NSEvent *)theEvent last_appdefined_event_data = [theEvent data1]; [self stop: self]; } + else + { + send_appdefined = YES; + } } @@ -5330,6 +5484,95 @@ - (void)sendFromMainThread:(id)unused ns_send_appdefined (nextappdefined); } +- (void)fd_handler:(id)unused +/* -------------------------------------------------------------------------- + Check data waiting on file descriptors and terminate if so + -------------------------------------------------------------------------- */ +{ + int result; + int waiting = 1, nfds; + char c; + + fd_set readfds, writefds, *wfds; + struct timespec timeout, *tmo; + NSAutoreleasePool *pool = nil; + + /* NSTRACE ("fd_handler"); */ + + for (;;) + { + [pool release]; + pool = [[NSAutoreleasePool alloc] init]; + + if (waiting) + { + fd_set fds; + FD_ZERO (&fds); + FD_SET (selfds[0], &fds); + result = select (selfds[0]+1, &fds, NULL, NULL, NULL); + if (result > 0 && read (selfds[0], &c, 1) == 1 && c == 'g') + waiting = 0; + } + else + { + pthread_mutex_lock (&select_mutex); + nfds = select_nfds; + + if (select_valid & SELECT_HAVE_READ) + readfds = select_readfds; + else + FD_ZERO (&readfds); + + if (select_valid & SELECT_HAVE_WRITE) + { + writefds = select_writefds; + wfds = &writefds; + } + else + wfds = NULL; + if (select_valid & SELECT_HAVE_TMO) + { + timeout = select_timeout; + tmo = &timeout; + } + else + tmo = NULL; + + pthread_mutex_unlock (&select_mutex); + + FD_SET (selfds[0], &readfds); + if (selfds[0] >= nfds) nfds = selfds[0]+1; + + result = pselect (nfds, &readfds, wfds, NULL, tmo, NULL); + + if (result == 0) + ns_send_appdefined (-2); + else if (result > 0) + { + if (FD_ISSET (selfds[0], &readfds)) + { + if (read (selfds[0], &c, 1) == 1 && c == 's') + waiting = 1; + } + else + { + pthread_mutex_lock (&select_mutex); + if (select_valid & SELECT_HAVE_READ) + select_readfds = readfds; + if (select_valid & SELECT_HAVE_WRITE) + select_writefds = writefds; + if (select_valid & SELECT_HAVE_TMO) + select_timeout = timeout; + pthread_mutex_unlock (&select_mutex); + + ns_send_appdefined (result); + } + } + waiting = 1; + } + } +} + /* ========================================================================== @@ -6118,7 +6361,7 @@ - (void)mouseMoved: (NSEvent *)e help_echo_object, help_echo_pos); } - if (emacsframe->mouse_moved) + if (emacsframe->mouse_moved && send_appdefined) ns_send_appdefined (-1); } @@ -6815,7 +7058,8 @@ - (void)windowDidExpose: sender SET_FRAME_VISIBLE (emacsframe, 1); SET_FRAME_GARBAGED (emacsframe); - ns_send_appdefined (-1); + if (send_appdefined) + ns_send_appdefined (-1); } commit 44c588a25ce231ce05fb535cd6d7162e91214f45 Author: Paul Eggert Date: Wed Jan 4 00:44:45 2017 -0800 Port recent autogen.sh changes to Darwin Problem reported by Sam Steingold (Bug#25347). * autogen.sh: Don't assume 'sed -f-' reads a script from stdin, as POSIX does not require it and it does not work on Darwin. diff --git a/autogen.sh b/autogen.sh index 91e1e2cea2..f6bfde6afb 100755 --- a/autogen.sh +++ b/autogen.sh @@ -223,7 +223,10 @@ Please report any problems with this script to bug-gnu-emacs@gnu.org .' ## Create nt/gnulib.mk if it doesn't exist, as autoreconf will need it. if test ! -f nt/gnulib.mk; then - sed '/^[^#]/s|^.*$|/^## begin *gnulib module &/,/^## end *gnulib module &/c ## gnulib module & removed|' nt/gnulib-modules-to-delete.cfg | sed -f- lib/gnulib.mk > nt/gnulib.mk + echo 'Inferring nt/gnulib.mk from lib/gnulib.mk ...' + metascript='/^[^#]/s|^.*$|/^## begin *gnulib module &/,/^## end *gnulib module &/c ## gnulib module & removed|' + script=`sed "$metascript" nt/gnulib-modules-to-delete.cfg` || exit + sed "$script" lib/gnulib.mk > nt/gnulib.mk || exit fi echo "Running 'autoreconf -fi -I m4' ..." commit 2ec41c415f39990561cc9da4c9bad0b69bfad489 Author: Stefan Monnier Date: Wed Jan 4 00:40:45 2017 -0500 Avoid add-to-list on local variables * lisp/gnus/nnir.el: Use lexical-binding and cl-lib. (nnir-retrieve-headers): Use pcase. (nnir-search-thread): Avoid add-to-list on local variables. * lisp/gnus/smime.el: Use lexical-binding and cl-lib. (smime-verify-region): Avoid add-to-list on local variables. * lisp/mail/undigest.el: Use lexical-binding and cl-lib. (rmail-digest-parse-mime, rmail-digest-rfc1153) (rmail-digest-parse-rfc934): Avoid add-to-list on local variable. * lisp/net/ldap.el (ldap-search): Move init into declaration. * lisp/net/newst-backend.el (newsticker--cache-add): Avoid add-to-list on local variables; Simplify code with `assq'. * lisp/net/zeroconf.el: Use lexical-binding and cl-lib. (dbus-debug): Remove declaration, unused. (zeroconf-service-add-hook, zeroconf-service-remove-hook) (zeroconf-service-browser-handler, zeroconf-publish-service): Avoid add-to-list and *-hook on local variables. * lisp/org/org-archive.el (org-all-archive-files): * lisp/org/org-agenda.el (org-agenda-get-restriction-and-command): Avoid add-to-list on local variables. * lisp/org/ox-publish.el (org-publish--run-functions): New function. (org-publish-projects): Use it to avoid run-hooks on a local variable. (org-publish-cache-file-needs-publishing): Avoid add-to-list on local variables. * lisp/progmodes/ada-prj.el: Use setq instead of (set '...). (ada-prj-load-from-file): Avoid add-to-list on local variables. * lisp/progmodes/ada-xref.el (ada-initialize-runtime-library): Simplify. (ada-gnat-parse-gpr, ada-parse-prj-file-1) (ada-xref-find-in-modified-ali): Avoid add-to-list on local variables. * lisp/progmodes/idlw-shell.el (idlwave-shell-update-bp-overlays): Avoid add-to-list on local variables. diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el index 536474cabc..9640f2c746 100644 --- a/lisp/gnus/nnir.el +++ b/lisp/gnus/nnir.el @@ -1,4 +1,4 @@ -;;; nnir.el --- search mail with various search engines -*- coding: utf-8 -*- +;;; nnir.el --- Search mail with various search engines -*- lexical-binding:t -*- ;; Copyright (C) 1998-2017 Free Software Foundation, Inc. @@ -175,8 +175,7 @@ (require 'gnus-group) (require 'message) (require 'gnus-util) -(eval-when-compile - (require 'cl)) +(eval-when-compile (require 'cl-lib)) ;;; Internal Variables: @@ -686,18 +685,18 @@ skips all prompting." parsefunc) ;; (nnir-possibly-change-group nil server) (erase-buffer) - (case (setq gnus-headers-retrieved-by - (or - (and - nnir-retrieve-headers-override-function - (funcall nnir-retrieve-headers-override-function - artlist artgroup)) - (gnus-retrieve-headers artlist artgroup nil))) - (nov + (pcase (setq gnus-headers-retrieved-by + (or + (and + nnir-retrieve-headers-override-function + (funcall nnir-retrieve-headers-override-function + artlist artgroup)) + (gnus-retrieve-headers artlist artgroup nil))) + ('nov (setq parsefunc 'nnheader-parse-nov)) - (headers + ('headers (setq parsefunc 'nnheader-parse-head)) - (t (error "Unknown header type %s while requesting articles \ + (_ (error "Unknown header type %s while requesting articles \ of group %s" gnus-headers-retrieved-by artgroup))) (goto-char (point-min)) (while (not (eobp)) @@ -831,7 +830,7 @@ skips all prompting." (nnir-possibly-change-group group server) (let (mlist) (dolist (action actions) - (destructuring-bind (range action marks) action + (cl-destructuring-bind (range action marks) action (let ((articles-by-group (nnir-categorize (gnus-uncompress-range range) nnir-article-group nnir-article-number))) @@ -839,7 +838,9 @@ skips all prompting." (push (list (car artgroup) (list (gnus-compress-sequence - (sort (cadr artgroup) '<)) action marks)) mlist))))) + (sort (cadr artgroup) '<)) + action marks)) + mlist))))) (dolist (request (nnir-categorize mlist car cadr)) (gnus-request-set-mark (car request) (cadr request))))) @@ -872,7 +873,7 @@ skips all prompting." (when (gnus-member-of-range (cdr art) read) (car art))) articleids)))) (dolist (mark marks) - (destructuring-bind (type . range) mark + (cl-destructuring-bind (type . range) mark (gnus-add-marked-articles group type (delq nil @@ -955,7 +956,7 @@ details on the language and supported extensions." (save-excursion (let ((qstring (cdr (assq 'query query))) (server (cadr (gnus-server-to-method srv))) - (defs (caddr (gnus-server-to-method srv))) + (defs (nth 2 (gnus-server-to-method srv))) (criteria (or (cdr (assq 'criteria query)) (cdr (assoc nnir-imap-default-search-key nnir-imap-search-arguments)))) @@ -1056,13 +1057,13 @@ In future the following will be added to the language: ;; Composite term: or expression ((eq (car-safe expr) 'or) (format "OR %s %s" - (nnir-imap-expr-to-imap criteria (second expr)) - (nnir-imap-expr-to-imap criteria (third expr)))) + (nnir-imap-expr-to-imap criteria (nth 1 expr)) + (nnir-imap-expr-to-imap criteria (nth 2 expr)))) ;; Composite term: just the fax, mam ((eq (car-safe expr) 'not) - (format "NOT (%s)" (nnir-imap-query-to-imap criteria (rest expr)))) + (format "NOT (%s)" (nnir-imap-query-to-imap criteria (cdr expr)))) ;; Composite term: just expand it all. - ((and (not (null expr)) (listp expr)) + ((consp expr) (format "(%s)" (nnir-imap-query-to-imap criteria expr))) ;; Complex value, give up for now. (t (error "Unhandled input: %S" expr)))) @@ -1223,8 +1224,8 @@ Windows NT 4.0." (exitstatus (progn (message "%s args: %s" nnir-swish++-program - (mapconcat 'identity (cddddr cp-list) " ")) ;; ??? - (apply 'call-process cp-list)))) + (mapconcat #'identity (nthcdr 4 cp-list) " ")) ;; ??? + (apply #'call-process cp-list)))) (unless (or (null exitstatus) (zerop exitstatus)) (nnheader-report 'nnir "Couldn't run swish++: %s" exitstatus) @@ -1259,7 +1260,7 @@ Windows NT 4.0." (message "Massaging swish++ output...done") ;; Sort by score - (apply 'vector + (apply #'vector (sort artlist (function (lambda (x y) (> (nnir-artitem-rsv x) @@ -1310,8 +1311,8 @@ Tested with swish-e-2.0.1 on Windows NT 4.0." (exitstatus (progn (message "%s args: %s" nnir-swish-e-program - (mapconcat 'identity (cddddr cp-list) " ")) - (apply 'call-process cp-list)))) + (mapconcat #'identity (nthcdr 4 cp-list) " ")) + (apply #'call-process cp-list)))) (unless (or (null exitstatus) (zerop exitstatus)) (nnheader-report 'nnir "Couldn't run swish-e: %s" exitstatus) @@ -1354,7 +1355,7 @@ Tested with swish-e-2.0.1 on Windows NT 4.0." (message "Massaging swish-e output...done") ;; Sort by score - (apply 'vector + (apply #'vector (sort artlist (function (lambda (x y) (> (nnir-artitem-rsv x) @@ -1387,8 +1388,8 @@ Tested with swish-e-2.0.1 on Windows NT 4.0." (exitstatus (progn (message "%s args: %s" nnir-hyrex-program - (mapconcat 'identity (cddddr cp-list) " ")) - (apply 'call-process cp-list)))) + (mapconcat #'identity (nthcdr 4 cp-list) " ")) + (apply #'call-process cp-list)))) (unless (or (null exitstatus) (zerop exitstatus)) (nnheader-report 'nnir "Couldn't run hyrex-search: %s" exitstatus) @@ -1421,7 +1422,7 @@ Tested with swish-e-2.0.1 on Windows NT 4.0." (string-to-number score)) artlist)) (message "Massaging hyrex-search output...done.") - (apply 'vector + (apply #'vector (sort artlist (function (lambda (x y) (if (string-lessp (nnir-artitem-group x) @@ -1467,8 +1468,8 @@ Tested with Namazu 2.0.6 on a GNU/Linux system." (exitstatus (progn (message "%s args: %s" nnir-namazu-program - (mapconcat 'identity (cddddr cp-list) " ")) - (apply 'call-process cp-list)))) + (mapconcat #'identity (nthcdr 4 cp-list) " ")) + (apply #'call-process cp-list)))) (unless (or (null exitstatus) (zerop exitstatus)) (nnheader-report 'nnir "Couldn't run namazu: %s" exitstatus) @@ -1495,7 +1496,7 @@ Tested with Namazu 2.0.6 on a GNU/Linux system." (nnir-add-result group article score prefix server artlist))) ;; sort artlist by score - (apply 'vector + (apply #'vector (sort artlist (function (lambda (x y) (> (nnir-artitem-rsv x) @@ -1543,8 +1544,8 @@ actually)." (exitstatus (progn (message "%s args: %s" nnir-notmuch-program - (mapconcat 'identity (cddddr cp-list) " ")) ;; ??? - (apply 'call-process cp-list)))) + (mapconcat #'identity (nthcdr 4 cp-list) " ")) ;; ??? + (apply #'call-process cp-list)))) (unless (or (null exitstatus) (zerop exitstatus)) (nnheader-report 'nnir "Couldn't run notmuch: %s" exitstatus) @@ -1639,7 +1640,7 @@ actually)." (art (string-to-number (car (last path))))) (while (string= "." (car path)) (setq path (cdr path))) - (let ((group (mapconcat 'identity + (let ((group (mapconcat #'identity ;; Replace cl-func: ;; (subseq path 0 -1) (let ((end (1- (length path))) @@ -1707,7 +1708,7 @@ actually)." (string-to-number (match-string 2 xref)) xscore) artlist))))) (forward-line 1))) - (apply 'vector (nreverse (delete-dups artlist))))) + (apply #'vector (nreverse (delete-dups artlist))))) ;;; Util Code: @@ -1719,8 +1720,8 @@ actually)." (defun nnir-read-parms (nnir-search-engine) "Reads additional search parameters according to `nnir-engines'." - (let ((parmspec (caddr (assoc nnir-search-engine nnir-engines)))) - (mapcar 'nnir-read-parm parmspec))) + (let ((parmspec (nth 2 (assoc nnir-search-engine nnir-engines)))) + (mapcar #'nnir-read-parm parmspec))) (defun nnir-read-parm (parmspec) "Reads a single search parameter. @@ -1728,7 +1729,7 @@ actually)." (let ((sym (car parmspec)) (prompt (cdr parmspec))) (if (listp prompt) - (let* ((result (apply 'gnus-completing-read prompt)) + (let* ((result (apply #'gnus-completing-read prompt)) (mapping (or (assoc result nnir-imap-search-arguments) (cons nil nnir-imap-search-other)))) (cons sym (format (cdr mapping) result))) @@ -1736,7 +1737,7 @@ actually)." (defun nnir-run-query (specs) "Invoke appropriate search engine function (see `nnir-engines')." - (apply 'vconcat + (apply #'vconcat (mapcar (lambda (x) (let* ((server (car x)) @@ -1796,7 +1797,8 @@ article came from is also searched." (and registry-group (gnus-method-to-server (gnus-find-method-for-group registry-group))))) - (when registry-server (add-to-list 'server (list registry-server))) + (when registry-server + (cl-pushnew (list registry-server) server :test #'equal)) (gnus-group-make-nnir-group nil (list (cons 'nnir-query-spec query) (cons 'nnir-group-spec server))) diff --git a/lisp/gnus/smime.el b/lisp/gnus/smime.el index 56c651fa7a..e3c284f033 100644 --- a/lisp/gnus/smime.el +++ b/lisp/gnus/smime.el @@ -1,4 +1,4 @@ -;;; smime.el --- S/MIME support library +;;; smime.el --- S/MIME support library -*- lexical-binding:t -*- ;; Copyright (C) 2000-2017 Free Software Foundation, Inc. @@ -122,7 +122,7 @@ (require 'password-cache) -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (defgroup smime nil "S/MIME configuration." @@ -243,13 +243,13 @@ password under `cache-key'." ;; OpenSSL wrappers. (defun smime-call-openssl-region (b e buf &rest args) - (case (apply 'call-process-region b e smime-openssl-program nil buf nil args) + (pcase (apply #'call-process-region b e smime-openssl-program nil buf nil args) (0 t) (1 (message "OpenSSL: An error occurred parsing the command options.") nil) (2 (message "OpenSSL: One of the input files could not be read.") nil) (3 (message "OpenSSL: An error occurred creating the PKCS#7 file or when reading the MIME message.") nil) (4 (message "OpenSSL: An error occurred decrypting or verifying the message.") nil) - (t (error "Unknown OpenSSL exitcode") nil))) + (_ (error "Unknown OpenSSL exitcode")))) (defun smime-make-certfiles (certfiles) (if certfiles @@ -373,7 +373,7 @@ Any details (stdout and stderr) are left in the buffer specified by (unless CAs (error "No CA configured")) (if smime-crl-check - (add-to-list 'CAs smime-crl-check)) + (cl-pushnew smime-crl-check CAs :test #'equal)) (if (apply 'smime-call-openssl-region b e (list smime-details-buffer t) "smime" "-verify" "-out" "/dev/null" CAs) t @@ -400,7 +400,7 @@ Any details (stderr on success, stdout and stderr on error) are left in the buffer specified by `smime-details-buffer'." (smime-new-details-buffer) (let ((buffer (generate-new-buffer " *smime*")) - CAs (passphrase (smime-ask-passphrase (expand-file-name keyfile))) + (passphrase (smime-ask-passphrase (expand-file-name keyfile))) (tmpfile (make-temp-file "smime"))) (if passphrase (setenv "GNUS_SMIME_PASSPHRASE" passphrase)) @@ -507,7 +507,7 @@ A string or a list of strings is returned." (let ((curkey (car keys)) (otherkeys (cdr keys))) (if (string= keyfile (cadr curkey)) - (caddr curkey) + (nth 2 curkey) (smime-get-certfiles keyfile otherkeys))))) (defun smime-buffer-as-string-region (b e) @@ -564,25 +564,29 @@ A string or a list of strings is returned." (concat "mail=" mail) host '("userCertificate") nil)) (retbuf (generate-new-buffer (format "*certificate for %s*" mail))) + ldapstr cert) - (if (and (>= (length ldapresult) 1) - (> (length (cadaar ldapresult)) 0)) + (if (and (consp ldapresult) + ;; FIXME: This seems to expect a format rather different from + ;; the list of alists described in ldap.el. + (setq ldapstr (cadr (caar ldapresult))) + (> (length ldapstr) 0)) (with-current-buffer retbuf ;; Certificates on LDAP servers _should_ be in DER format, ;; but there are some servers out there that distributes the ;; certificates in PEM format (with or without ;; header/footer) so we try to handle them anyway. - (if (or (string= (substring (cadaar ldapresult) 0 27) + (if (or (string= (substring ldapstr 0 27) "-----BEGIN CERTIFICATE-----") - (string= (substring (cadaar ldapresult) 0 3) + (string= (substring ldapstr 0 3) "MII")) (setq cert (replace-regexp-in-string (concat "\\(\n\\|\r\\|-----BEGIN CERTIFICATE-----\\|" "-----END CERTIFICATE-----\\)") "" - (cadaar ldapresult) nil t)) - (setq cert (base64-encode-string (cadaar ldapresult) t))) + ldapstr nil t)) + (setq cert (base64-encode-string ldapstr t))) (insert "-----BEGIN CERTIFICATE-----\n") (let ((i 0) (len (length cert))) (while (> (- len 64) i) diff --git a/lisp/mail/undigest.el b/lisp/mail/undigest.el index c9200745e0..73d7464bc1 100644 --- a/lisp/mail/undigest.el +++ b/lisp/mail/undigest.el @@ -1,4 +1,4 @@ -;;; undigest.el --- digest-cracking support for the RMAIL mail reader +;;; undigest.el --- digest-cracking support for the RMAIL mail reader -*- lexical-binding:t -*- ;; Copyright (C) 1985-1986, 1994, 1996, 2001-2017 Free Software ;; Foundation, Inc. @@ -28,6 +28,7 @@ ;;; Code: +(eval-when-compile (require 'cl-lib)) (require 'rmail) (defcustom rmail-forward-separator-regex @@ -59,7 +60,8 @@ each undigestified message as markers.") (re-search-forward (concat "^Content-type: multipart/digest;" - "\\s-* boundary=\"?\\([^\";\n]+\\)[\";\n]") head-end t) + "\\s-* boundary=\"?\\([^\";\n]+\\)[\";\n]") + head-end t) (search-forward (match-string 1) nil t))) ;; Ok, prolog separator found (let ((start (make-marker)) @@ -69,7 +71,8 @@ each undigestified message as markers.") (while (search-forward separator nil t) (move-marker start (match-beginning 0)) (move-marker end (match-end 0)) - (add-to-list 'result (cons (copy-marker start) (copy-marker end t)))) + (cl-pushnew (cons (copy-marker start) (copy-marker end t)) + result :test #'equal)) ;; Return the list of marker pairs (nreverse result)))) @@ -117,8 +120,8 @@ See rmail-digest-methods." (while (search-forward separator nil t) (move-marker start (match-beginning 0)) (move-marker end (match-end 0)) - (add-to-list 'result - (cons (copy-marker start) (copy-marker end t)))) + (cl-pushnew (cons (copy-marker start) (copy-marker end t)) + result :test #'equal)) ;; Undo masking of separators inside digestified messages (goto-char (point-min)) (while (search-forward @@ -139,7 +142,8 @@ See rmail-digest-methods." (while (search-forward separator nil t) (move-marker start (match-beginning 0)) (move-marker end (match-end 0)) - (add-to-list 'result (cons (copy-marker start) (copy-marker end t)))) + (cl-pushnew (cons (copy-marker start) (copy-marker end t)) + result :test #'equal)) ;; Undo masking of separators inside digestified messages (goto-char (point-min)) (while (search-forward "\n- -" nil t) diff --git a/lisp/net/ldap.el b/lisp/net/ldap.el index f4910b1dc7..d530338766 100644 --- a/lisp/net/ldap.el +++ b/lisp/net/ldap.el @@ -470,18 +470,17 @@ Additional search parameters can be specified through (or host (setq host ldap-default-host) (error "No LDAP host specified")) - (let ((host-plist (cdr (assoc host ldap-host-parameters-alist))) - result) - (setq result (ldap-search-internal `(host ,host + (let* ((host-plist (cdr (assoc host ldap-host-parameters-alist))) + (result (ldap-search-internal `(host ,host filter ,filter attributes ,attributes attrsonly ,attrsonly withdn ,withdn - ,@host-plist))) + ,@host-plist)))) (if ldap-ignore-attribute-codings result (mapcar (lambda (record) - (mapcar 'ldap-decode-attribute record)) + (mapcar #'ldap-decode-attribute record)) result)))) (defun ldap-password-read (host) diff --git a/lisp/net/newst-backend.el b/lisp/net/newst-backend.el index 30a9e54b73..f38c72a26b 100644 --- a/lisp/net/newst-backend.el +++ b/lisp/net/newst-backend.el @@ -2124,15 +2124,12 @@ which the item got." (setq item (list title desc link time age position preformatted-contents preformatted-title extra-elements)) ;;(newsticker--debug-msg "Adding item %s" item) - (catch 'found - (mapc (lambda (this-feed) - (when (eq (car this-feed) feed-name-symbol) - (setcdr this-feed (nconc (cdr this-feed) (list item))) - (throw 'found this-feed))) - data) - ;; the feed is not contained - (add-to-list 'data (list feed-name-symbol item) t)))) - data) + (let ((this-feed (assq feed-name-symbol data))) + (if this-feed + (setcdr this-feed (nconc (cdr this-feed) (list item))) + ;; The feed is not contained. + (setq data (append data (list (list feed-name-symbol item))))))) + data)) (defun newsticker--cache-remove (data feed-symbol age) "Remove all entries from DATA in the feed FEED-SYMBOL with AGE. diff --git a/lisp/net/zeroconf.el b/lisp/net/zeroconf.el index 3db65c624e..37816bb888 100644 --- a/lisp/net/zeroconf.el +++ b/lisp/net/zeroconf.el @@ -1,4 +1,4 @@ -;;; zeroconf.el --- Service browser using Avahi. +;;; zeroconf.el --- Service browser using Avahi. -*- lexical-binding:t -*- ;; Copyright (C) 2008-2017 Free Software Foundation, Inc. @@ -99,10 +99,7 @@ ;;; Code: -;; Pacify byte-compiler. D-Bus support in the Emacs core can be -;; disabled with configuration option "--without-dbus". Declare used -;; subroutines and variables of `dbus' therefore. -(defvar dbus-debug) +(eval-when-compile (require 'cl-lib)) (require 'dbus) @@ -296,7 +293,7 @@ The key of an entry is a service type.") (defun zeroconf-service-add-hook (type event function) "Add FUNCTION to the hook of service type TYPE. -EVENT must be either :new or :removed, indicating whether +EVENT must be either `:new' or `:removed', indicating whether FUNCTION shall be called when a new service has been newly detected, or removed. @@ -320,15 +317,13 @@ The attributes of SERVICE can be retrieved via the functions (cond ((equal event :new) - (let ((l-hook (gethash type zeroconf-service-added-hooks-hash nil))) - (add-hook 'l-hook function) - (puthash type l-hook zeroconf-service-added-hooks-hash) - (dolist (service (zeroconf-list-services type)) - (funcall function service)))) + (cl-pushnew function (gethash type zeroconf-service-added-hooks-hash) + :test #'equal) + (dolist (service (zeroconf-list-services type)) + (funcall function service))) ((equal event :removed) - (let ((l-hook (gethash type zeroconf-service-removed-hooks-hash nil))) - (add-hook 'l-hook function) - (puthash type l-hook zeroconf-service-removed-hooks-hash))) + (cl-pushnew function (gethash type zeroconf-service-removed-hooks-hash) + :test #'equal)) (t (error "EVENT must be either `:new' or `:removed'")))) (defun zeroconf-service-remove-hook (type event function) @@ -336,16 +331,13 @@ The attributes of SERVICE can be retrieved via the functions EVENT must be either :new or :removed and has to match the event type used when registering FUNCTION." - (let* ((table (cond - ((equal event :new) - zeroconf-service-added-hooks-hash) - ((equal event :removed) - zeroconf-service-removed-hooks-hash) - (t (error "EVENT must be either `:new' or `:removed'")))) - (l-hook (gethash type table nil))) - (remove-hook 'l-hook function) - (if l-hook - (puthash type l-hook table) + (let* ((table (pcase event + (:new zeroconf-service-added-hooks-hash) + (:removed zeroconf-service-removed-hooks-hash) + (_ (error "EVENT must be either `:new' or `:removed'")))) + (functions (remove function (gethash type table)))) + (if functions + (puthash type functions table) (remhash type table)))) (defun zeroconf-get-host () @@ -580,13 +572,13 @@ DOMAIN is nil, the local domain is used." ((string-equal (dbus-event-member-name last-input-event) "ItemNew") ;; Add new service. (puthash key val zeroconf-services-hash) - (run-hook-with-args 'ahook val)) + (dolist (f ahook) (funcall f val))) ((string-equal (dbus-event-member-name last-input-event) "ItemRemove") ;; Remove the service. (remhash key zeroconf-services-hash) (remhash key zeroconf-resolved-services-hash) - (run-hook-with-args 'rhook val))))) + (dolist (f rhook) (funcall f val)))))) (defun zeroconf-register-service-resolver (name type) "Register a service resolver at the Avahi daemon." @@ -653,7 +645,7 @@ For the description of arguments, see `zeroconf-resolved-services-hash'." ;; The TXT field has the signature "as". Transform to "aay". (dolist (elt txt) - (add-to-list 'result (dbus-string-to-byte-array elt))) + (cl-pushnew (dbus-string-to-byte-array elt) result :test #'equal)) ;; Add the service. (dbus-call-method diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el index e119d9ffeb..c870ddd4e4 100644 --- a/lisp/org/org-agenda.el +++ b/lisp/org/org-agenda.el @@ -2928,7 +2928,7 @@ L Timeline for current buffer # List stuck projects (!=configure) type (nth 2 entry) match (nth 3 entry)) (if (> (length key) 1) - (add-to-list 'prefixes (string-to-char key)) + (pushnew (string-to-char key) prefixes :test #'equal) (setq line (format "%-4s%-14s" diff --git a/lisp/org/org-archive.el b/lisp/org/org-archive.el index a7afa19c0f..39a6581046 100644 --- a/lisp/org/org-archive.el +++ b/lisp/org/org-archive.el @@ -29,6 +29,7 @@ ;;; Code: (require 'org) +(eval-when-compile (require 'cl)) (declare-function org-inlinetask-remove-END-maybe "org-inlinetask" ()) (declare-function org-datetree-find-date-create "org-datetree" (date &optional keep-restriction)) @@ -163,11 +164,11 @@ archive file is." (setq file (org-extract-archive-file (org-match-string-no-properties 2))) (and file (> (length file) 0) (file-exists-p file) - (add-to-list 'files file))))) + (pushnew file files :test #'equal))))) (setq files (nreverse files)) (setq file (org-extract-archive-file)) (and file (> (length file) 0) (file-exists-p file) - (add-to-list 'files file)) + (pushnew file files :test #'equal)) files)) (defun org-extract-archive-file (&optional location) diff --git a/lisp/org/ox-publish.el b/lisp/org/ox-publish.el index fdab9ac46e..4ebc073990 100644 --- a/lisp/org/ox-publish.el +++ b/lisp/org/ox-publish.el @@ -662,6 +662,13 @@ See `org-publish-projects'." filename pub-dir publishing-function base-dir))) (unless no-cache (org-publish-write-cache-file)))) +(defun org-publish--run-functions (functions) + (cond + ((null functions) nil) + ((functionp functions) (funcall functions)) + ((consp functions) (mapc #'funcall functions)) + (t (error "Neither a function nor a list: %S" functions)))) + (defun org-publish-projects (projects) "Publish all files belonging to the PROJECTS alist. If `:auto-sitemap' is set, publish the sitemap too. If @@ -690,7 +697,7 @@ If `:auto-sitemap' is set, publish the sitemap too. If (theindex (expand-file-name "theindex.org" (plist-get project-plist :base-directory)))) - (when preparation-function (run-hooks 'preparation-function)) + (org-publish--run-functions preparation-function) (if sitemap-p (funcall sitemap-function project sitemap-filename)) ;; Publish all files from PROJECT excepted "theindex.org". Its ;; publishing will be deferred until "theindex.inc" is @@ -704,7 +711,7 @@ If `:auto-sitemap' is set, publish the sitemap too. If (org-publish-index-generate-theindex project (plist-get project-plist :base-directory)) (org-publish-file theindex project t)) - (when completion-function (run-hooks 'completion-function)) + (org-publish--run-functions completion-function) (org-publish-write-cache-file))) (org-publish-expand-projects projects))) @@ -1171,9 +1178,13 @@ the file including them will be republished as well." (goto-char (point-min)) (while (re-search-forward "^#\\+INCLUDE:[ \t]+\"\\([^\t\n\r\"]*\\)\"[ \t]*.*$" nil t) - (let* ((included-file (expand-file-name (match-string 1)))) - (add-to-list 'included-files-ctime - (org-publish-cache-ctime-of-src included-file) t)))) + (let* ((included-file (expand-file-name (match-string 1))) + (ctime (org-publish-cache-ctime-of-src included-file))) + (unless (member ctime included-files-ctime) + ;; FIXME: The original code insisted on appending this ctime + ;; to the end of the list, even tho the order seems irrelevant. + (setq included-files-ctime + (append included-files-ctime (list ctime))))))) (unless visiting (kill-buffer buf))) (if (null pstamp) t (let ((ctime (org-publish-cache-ctime-of-src filename))) diff --git a/lisp/progmodes/ada-prj.el b/lisp/progmodes/ada-prj.el index a49e5168b2..f1b9087504 100644 --- a/lisp/progmodes/ada-prj.el +++ b/lisp/progmodes/ada-prj.el @@ -24,17 +24,13 @@ ;;; Commentary: -;;; This package provides a set of functions to easily edit the project -;;; files used by the ada-mode. -;;; The only function publicly available here is `ada-customize'. -;;; See the documentation of the Ada mode for more information on the project -;;; files. -;;; Internally, a project file is represented as a property list, with each -;;; field of the project file matching one property of the list. - - -;;; History: -;; +;; This package provides a set of functions to easily edit the project +;; files used by the ada-mode. +;; The only function publicly available here is `ada-customize'. +;; See the documentation of the Ada mode for more information on the project +;; files. +;; Internally, a project file is represented as a property list, with each +;; field of the project file matching one property of the list. ;;; Code: @@ -45,7 +41,8 @@ (require 'ada-xref) (eval-when-compile - (require 'ada-mode)) + (require 'ada-mode)) +(eval-when-compile (require 'cl-lib)) ;; ----- Buffer local variables ------------------------------------------- @@ -125,7 +122,7 @@ If the current value of FIELD is the default value, return an empty string." (let ((file-name (or (plist-get ada-prj-current-values 'filename) (read-file-name "Save project as: "))) output) - (set 'output + (setq output (concat ;; Save the fields that do not depend on the current buffer @@ -176,7 +173,7 @@ If the current value of FIELD is the default value, return an empty string." (kill-buffer "*Edit Ada Mode Project*") ;; automatically set the new project file as the active one - (set 'ada-prj-default-project-file file-name) + (setq ada-prj-default-project-file file-name) ;; force Emacs to reread the project files (ada-reread-prj-file file-name) @@ -195,12 +192,12 @@ One item per line should be found in the file." (widen) (goto-char (point-min)) (while (not (eobp)) - (set 'line (buffer-substring-no-properties (point) (point-at-eol))) - (add-to-list 'list line) + (setq line (buffer-substring-no-properties (point) (point-at-eol))) + (cl-pushnew line list :test #'equal) (forward-line 1)) (kill-buffer nil) (set-buffer buffer) - (set 'ada-prj-current-values + (setq ada-prj-current-values (plist-put ada-prj-current-values symbol (append (plist-get ada-prj-current-values symbol) @@ -215,8 +212,8 @@ One item per line should be found in the file." (if (file-directory-p (car subdirs)) (let ((sub (ada-prj-subdirs-of (car subdirs)))) (if sub - (set 'dirlist (append sub dirlist))))) - (set 'subdirs (cdr subdirs))) + (setq dirlist (append sub dirlist))))) + (setq subdirs (cdr subdirs))) dirlist)) (defun ada-prj-load-directory (field &optional file-name) @@ -227,9 +224,9 @@ If FILE-NAME is nil, ask the user for the name." ;; the user to select a directory (let ((use-dialog-box nil)) (unless file-name - (set 'file-name (read-directory-name "Root directory: " nil nil t)))) + (setq file-name (read-directory-name "Root directory: " nil nil t)))) - (set 'ada-prj-current-values + (setq ada-prj-current-values (plist-put ada-prj-current-values field (append (plist-get ada-prj-current-values field) @@ -551,7 +548,7 @@ converted to a directory name." Remaining args DUMMY are ignored. Save the change in `ada-prj-current-values' so that selecting another page and coming back keeps the new value." - (set 'ada-prj-current-values + (setq ada-prj-current-values (plist-put ada-prj-current-values (widget-get widget ':prj-field) (widget-value widget)))) @@ -621,7 +618,7 @@ AFTER-TEXT is inserted just after the widget." (inhibit-read-only t) widget) (unless value - (set 'value + (setq value (if is-list '() ""))) (widget-insert text) (widget-insert ":") @@ -649,7 +646,7 @@ AFTER-TEXT is inserted just after the widget." "Load Recursive Directory") (widget-insert "\n ${build_dir}\n"))) - (set 'widget + (setq widget (if is-list (if (< (length value) 15) (widget-create 'editable-list diff --git a/lisp/progmodes/ada-xref.el b/lisp/progmodes/ada-xref.el index 4da81da785..4e196505b6 100644 --- a/lisp/progmodes/ada-xref.el +++ b/lisp/progmodes/ada-xref.el @@ -25,19 +25,14 @@ ;; along with GNU Emacs. If not, see . ;;; Commentary: -;;; This Package provides a set of functions to use the output of the -;;; cross reference capabilities of the GNAT Ada compiler -;;; for lookup and completion in Ada mode. -;;; -;;; If a file *.`adp' exists in the ada-file directory, then it is -;;; read for configuration information. It is read only the first -;;; time a cross-reference is asked for, and is not read later. -;;; You need Emacs >= 20.2 to run this package - - -;;; History: +;; This Package provides a set of functions to use the output of the +;; cross reference capabilities of the GNAT Ada compiler +;; for lookup and completion in Ada mode. ;; +;; If a file *.`adp' exists in the ada-file directory, then it is +;; read for configuration information. It is read only the first +;; time a cross-reference is asked for, and is not read later. ;;; Code: @@ -47,6 +42,7 @@ (require 'comint) (require 'find-file) (require 'ada-mode) +(eval-when-compile (require 'cl-lib)) ;; ------ User variables (defcustom ada-xref-other-buffer t @@ -318,9 +314,9 @@ CROSS-PREFIX is the prefix to use for the `gnatls' command." (forward-line 1) (while (not (looking-at "^$")) (back-to-indentation) - (if (looking-at "") - (add-to-list 'ada-xref-runtime-library-specs-path ".") - (add-to-list 'ada-xref-runtime-library-specs-path + (add-to-list 'ada-xref-runtime-library-specs-path + (if (looking-at "") + "." (buffer-substring-no-properties (point) (point-at-eol)))) @@ -332,9 +328,9 @@ CROSS-PREFIX is the prefix to use for the `gnatls' command." (forward-line 1) (while (not (looking-at "^$")) (back-to-indentation) - (if (looking-at "") - (add-to-list 'ada-xref-runtime-library-ali-path ".") - (add-to-list 'ada-xref-runtime-library-ali-path + (add-to-list 'ada-xref-runtime-library-ali-path + (if (looking-at "") + "." (buffer-substring-no-properties (point) (point-at-eol)))) @@ -380,12 +376,12 @@ Assumes environment variable ADA_PROJECT_PATH is set properly." (forward-line 1) ; first directory in list (while (not (looking-at "^$")) ; terminate on blank line (back-to-indentation) ; skip whitespace - (add-to-list 'src-dir - (if (looking-at "") - default-directory - (expand-file-name - (buffer-substring-no-properties - (point) (line-end-position))))) + (cl-pushnew (if (looking-at "") + default-directory + (expand-file-name + (buffer-substring-no-properties + (point) (line-end-position)))) + src-dir :test #'equal) (forward-line 1)) ;; Object path @@ -394,12 +390,12 @@ Assumes environment variable ADA_PROJECT_PATH is set properly." (forward-line 1) (while (not (looking-at "^$")) (back-to-indentation) - (add-to-list 'obj-dir - (if (looking-at "") - default-directory - (expand-file-name - (buffer-substring-no-properties - (point) (line-end-position))))) + (cl-pushnew (if (looking-at "") + default-directory + (expand-file-name + (buffer-substring-no-properties + (point) (line-end-position)))) + obj-dir :test #'equal) (forward-line 1)) ;; Set properties @@ -831,9 +827,9 @@ Return new value of PROJECT." ;; FIXME: strip trailing spaces ;; variable name alphabetical order ((string= (match-string 1) "ada_project_path") - (add-to-list 'ada_project_path - (expand-file-name - (substitute-in-file-name (match-string 2))))) + (cl-pushnew (expand-file-name + (substitute-in-file-name (match-string 2))) + ada_project_path :test #'equal)) ((string= (match-string 1) "build_dir") (setq project @@ -841,40 +837,40 @@ Return new value of PROJECT." (file-name-as-directory (match-string 2))))) ((string= (match-string 1) "casing") - (add-to-list 'casing - (expand-file-name (substitute-in-file-name (match-string 2))))) + (cl-pushnew (expand-file-name (substitute-in-file-name (match-string 2))) + casing :test #'equal)) ((string= (match-string 1) "check_cmd") - (add-to-list 'check_cmd (match-string 2))) + (cl-pushnew (match-string 2) check_cmd :test #'equal)) ((string= (match-string 1) "comp_cmd") - (add-to-list 'comp_cmd (match-string 2))) + (cl-pushnew (match-string 2) comp_cmd :test #'equal)) ((string= (match-string 1) "debug_post_cmd") - (add-to-list 'debug_post_cmd (match-string 2))) + (cl-pushnew (match-string 2) debug_post_cmd :test #'equal)) ((string= (match-string 1) "debug_pre_cmd") - (add-to-list 'debug_pre_cmd (match-string 2))) + (cl-pushnew (match-string 2) debug_pre_cmd :test #'equal)) ((string= (match-string 1) "gpr_file") ;; expand now; path is relative to Emacs project file (setq gpr_file (expand-file-name (match-string 2)))) ((string= (match-string 1) "make_cmd") - (add-to-list 'make_cmd (match-string 2))) + (cl-pushnew (match-string 2) make_cmd :test #'equal)) ((string= (match-string 1) "obj_dir") - (add-to-list 'obj_dir - (file-name-as-directory - (expand-file-name (match-string 2))))) + (cl-pushnew (file-name-as-directory + (expand-file-name (match-string 2))) + obj_dir :test #'equal)) ((string= (match-string 1) "run_cmd") - (add-to-list 'run_cmd (match-string 2))) + (cl-pushnew (match-string 2) run_cmd :test #'equal)) ((string= (match-string 1) "src_dir") - (add-to-list 'src_dir - (file-name-as-directory - (expand-file-name (match-string 2))))) + (cl-pushnew (file-name-as-directory + (expand-file-name (match-string 2))) + src_dir :test #'equal)) (t ;; any other field in the file is just copied @@ -1866,8 +1862,8 @@ This function is disabled for operators, and only works for identifiers." ) ;; construct a list with the file names and the positions within (if (re-search-backward "^X [0-9]+ \\([a-zA-Z0-9._-]+\\)" nil t) - (add-to-list - 'declist (list line-ali (match-string 1) line-ada col-ada)) + (cl-pushnew (list line-ali (match-string 1) line-ada col-ada) + declist :test #'equal) ) ) ) diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el index 689c1ade8a..1282f08b07 100644 --- a/lisp/progmodes/idlw-shell.el +++ b/lisp/progmodes/idlw-shell.el @@ -3597,7 +3597,7 @@ Existing overlays are recycled, in order to minimize consumption." (if ov-alist (while (setq ov-list (pop ov-alist)) (while (setq ov (pop (cdr ov-list))) - (add-to-list 'old-buffers (overlay-buffer ov)) + (pushnew (overlay-buffer ov) old-buffers) (delete-overlay ov)))) (setq ov-alist idlwave-shell-bp-overlays commit f49f8c1454e19123572a071bf582271c70d28f01 Author: Mark Oteiza Date: Tue Jan 3 18:34:13 2017 -0500 Turn on lexical-binding in md4.el * lisp/md4.el: Turn on lexical-binding. * test/lisp/md4-tests.el: New file. diff --git a/lisp/md4.el b/lisp/md4.el index 79a76c45eb..23d00ab060 100644 --- a/lisp/md4.el +++ b/lisp/md4.el @@ -1,4 +1,4 @@ -;;; md4.el --- MD4 Message Digest Algorithm. +;;; md4.el --- MD4 Message Digest Algorithm. -*- lexical-binding: t -*- ;; Copyright (C) 2001, 2004, 2007-2017 Free Software Foundation, Inc. diff --git a/test/lisp/md4-tests.el b/test/lisp/md4-tests.el new file mode 100644 index 0000000000..169ed83448 --- /dev/null +++ b/test/lisp/md4-tests.el @@ -0,0 +1,61 @@ +;;; md4-tests.el --- tests for md4.el -*- lexical-binding: t -*- + +;; Copyright (C) 2017 Free Software Foundation, Inc. + +;; Author: Mark Oteiza +;; Maintainer: emacs-devel@gnu.org + +;; 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) +(require 'md4) + +(defun md4-tests-digest->hex (str) + "Print digest STR in hexadecimal." + (mapconcat (lambda (x) (format "%02x" x)) str "")) + +(ert-deftest md4-test-rfc1320 () + "Verify the test suite results in RFC 1320. +See ." + (should + (equal (md4-tests-digest->hex (md4 "" 0)) + "31d6cfe0d16ae931b73c59d7e0c089c0")) + (should + (equal (md4-tests-digest->hex (md4 "a" 1)) + "bde52cb31de33e46245e05fbdbd6fb24")) + (should + (equal (md4-tests-digest->hex (md4 "abc" 3)) + "a448017aaf21d8525fc10ae87aa6729d")) + (should + (equal (md4-tests-digest->hex (md4 "message digest" 14)) + "d9130a8164549fe818874806e1c7014b")) + (should + (equal (md4-tests-digest->hex (md4 "abcdefghijklmnopqrstuvwxyz" 26)) + "d79e1c308aa5bbcdeea8ed63df412da9")) + (should + (equal (md4-tests-digest->hex + (md4 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" 62)) + "043f8582f241db351ce627e153e7f0e4")) + (should + (equal (md4-tests-digest->hex + (md4 "12345678901234567890123456789012345678901234567890123456789012345678901234567890" 80)) + "e33b4ddc9c38f2199c3e7b164fcc0536"))) + +;;; md4-tests.el ends here commit 9ed3685a778843cbc0df3ca2490f79eb4e2ebefe Author: Stefan Merten Date: Tue Jan 3 23:15:13 2017 +0100 Lots of refactorings and a few minor improvements. User visible improvements and changes: * Improve and debug `rst-forward-section` and `rst-backward-section`. * Auto-enumeration may be used with all styles for list insertion. * Improve and debug `rst-toc-insert`. * Adapt change in Emacs to use customization group `text` instead of `wp`. * Bind `n` and `p` in `rst-toc-mode`. * `z` in `toc-mode` returns to the previous window configuration. * Require Emacs version >= 24.1. Lots of refactorings including: * Silence byte compiler. * Use lexical binding. * Use `cl-lib`. * Add tests and raise test coverage. diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el index 90c1f4539d..edc4885060 100644 --- a/lisp/textmodes/rst.el +++ b/lisp/textmodes/rst.el @@ -1,4 +1,4 @@ -;;; rst.el --- Mode for viewing and editing reStructuredText-documents. +;;; rst.el --- Mode for viewing and editing reStructuredText-documents -*- lexical-binding: t -*- ;; Copyright (C) 2003-2017 Free Software Foundation, Inc. @@ -100,15 +100,30 @@ ;; FIXME: Check through major mode conventions again. -;; FIXME: Add proper ";;;###autoload" comments. - -;; FIXME: When 24.1 is common place remove use of `lexical-let' and put "-*- -;; lexical-binding: t -*-" in the first line. - ;; FIXME: Embed complicated `defconst's in `eval-when-compile'. -;; FIXME: Use `testcover'. Mark up a function with sufficient test coverage by -;; a comment tagged with `testcover' after the `defun'. +;; Common Lisp stuff +(require 'cl-lib) + +;; Correct wrong declaration. +(def-edebug-spec push + (&or [form symbolp] [form gv-place])) + +;; Correct wrong declaration. This still doesn't support dotted desctructuring +;; though. +(def-edebug-spec cl-lambda-list + (([&rest cl-macro-arg] + [&optional ["&optional" cl-&optional-arg &rest cl-&optional-arg]] + [&optional ["&rest" arg]] + [&optional ["&key" [cl-&key-arg &rest cl-&key-arg] + &optional "&allow-other-keys"]] + [&optional ["&aux" &rest + &or (symbolp &optional def-form) symbolp]] + ))) + +;; Add missing declaration. +(def-edebug-spec cl-type-spec sexp) ;; This is not exactly correct but good + ;; enough. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Support for `testcover' @@ -129,9 +144,9 @@ considered constants. Revert it with this function after each `defcustom'." (setq testcover-module-constants (delq nil (mapcar - (lambda (sym) - (if (not (plist-member (symbol-plist sym) 'standard-value)) - sym)) + #'(lambda (sym) + (if (not (plist-member (symbol-plist sym) 'standard-value)) + sym)) testcover-module-constants))))) (defun rst-testcover-add-compose (fun) @@ -144,69 +159,72 @@ considered constants. Revert it with this function after each `defcustom'." (when (boundp 'testcover-1value-functions) (add-to-list 'testcover-1value-functions fun))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Common Lisp stuff - -;; Only use of macros is allowed - may be replaced by `cl-lib' some time. -(eval-when-compile - (require 'cl)) - -;; Redefine some functions from `cl.el' in a proper namespace until they may be -;; used from there. - -(defun rst-signum (x) +;; Helpers. + +(cl-defmacro rst-destructuring-dolist + ((arglist list &optional result) &rest body) + "`cl-dolist' with destructuring of the list elements. +ARGLIST is a Common List argument list which may include +destructuring. LIST, RESULT and BODY are as for `cl-dolist'. +Note that definitions in ARGLIST are visible only in the BODY and +neither in RESULT nor in LIST." + ;; FIXME: It would be very useful if the definitions in ARGLIST would be + ;; visible in RESULT. But may be this is rather a + ;; `rst-destructuring-do' then. + (declare (debug + (&define ([&or symbolp cl-macro-list] def-form &optional def-form) + cl-declarations def-body)) + (indent 1)) + (let ((var (make-symbol "--rst-destructuring-dolist-var--"))) + `(cl-dolist (,var ,list ,result) + (cl-destructuring-bind ,arglist ,var + ,@body)))) + +(defun rst-forward-line-strict (n &optional limit) ;; testcover: ok. - "Return 1 if X is positive, -1 if negative, 0 if zero." - (cond - ((> x 0) 1) - ((< x 0) -1) - (t 0))) - -(defun rst-some (seq &optional pred) - ;; testcover: ok. - "Return non-nil if any element of SEQ yields non-nil when PRED is applied. -Apply PRED to each element of list SEQ until the first non-nil -result is yielded and return this result. PRED defaults to -`identity'." - (unless pred - (setq pred 'identity)) - (catch 'rst-some - (dolist (elem seq) - (let ((r (funcall pred elem))) - (when r - (throw 'rst-some r)))))) - -(defun rst-position-if (pred seq) - ;; testcover: ok. - "Return position of first element satisfying PRED in list SEQ or nil." - (catch 'rst-position-if - (let ((i 0)) - (dolist (elem seq) - (when (funcall pred elem) - (throw 'rst-position-if i)) - (incf i))))) - -(defun rst-position (elem seq) + "Try to move point to beginning of line I + N where I is the current line. +Return t if movement is successful. Otherwise don't move point +and return nil. If a position is given by LIMIT, movement +happened but the following line is missing and thus its beginning +can not be reached but the movement reached at least LIMIT +consider this a successful movement. LIMIT is ignored in other +cases." + (let ((start (point))) + (if (and (zerop (forward-line n)) + (or (bolp) + (and limit + (>= (point) limit)))) + t + (goto-char start) + nil))) + +(defun rst-forward-line-looking-at (n rst-re-args &optional fun) ;; testcover: ok. - "Return position of ELEM in list SEQ or nil. -Comparison done with `equal'." - ;; Create a closure containing `elem' so the `lambda' always sees our - ;; parameter instead of an `elem' which may be in dynamic scope at the time - ;; of execution of the `lambda'. - (lexical-let ((elem elem)) - (rst-position-if (function (lambda (e) - (equal elem e))) - seq))) - -(defun rst-member-if (pred seq) - ;; testcover: ok. - "Return sublist of SEQ starting with the element whose car satisfies PRED." - (let (found) - (while (and (not found) seq) - (if (funcall pred (car seq)) - (setq found seq) - (setq seq (cdr seq)))) - found)) + "Move forward N lines and if successful check whether RST-RE-ARGS is matched. +Moving forward is done by `rst-forward-line-strict'. RST-RE-ARGS +is a single or a list of arguments for `rst-re'. FUN is a +function defaulting to `identity' which is called after the call +to `looking-at' receiving its return value as the first argument. +When FUN is called match data is just set by `looking-at' and +point is at the beginning of the line. Return nil if moving +forward failed or otherwise the return value of FUN. Preserve +global match data, point, mark and current buffer." + (unless (listp rst-re-args) + (setq rst-re-args (list rst-re-args))) + (unless fun + (setq fun #'identity)) + (save-match-data + (save-excursion + (when (rst-forward-line-strict n) + (funcall fun (looking-at (apply #'rst-re rst-re-args))))))) + +(rst-testcover-add-1value 'rst-delete-entire-line) +(defun rst-delete-entire-line (n) + "Move N lines and delete the entire line." + (delete-region (line-beginning-position (+ n 1)) + (line-beginning-position (+ n 2)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -226,7 +244,7 @@ and before TAIL-RE and DELIM-RE in VAR or DEFAULT for no match." ;; Use CVSHeader to really get information from CVS and not other version ;; control systems. (defconst rst-cvs-header - "$CVSHeader: sm/rst_el/rst.el,v 1.600 2016/07/31 11:13:44 stefan Exp $") + "$CVSHeader: sm/rst_el/rst.el,v 1.1058.2.3 2017/01/03 21:56:29 stefan Exp $") (defconst rst-cvs-rev (rst-extract-version "\\$" "CVSHeader: \\S + " "[0-9]+\\(?:\\.[0-9]+\\)+" " .*" rst-cvs-header "0.0") @@ -240,22 +258,22 @@ and before TAIL-RE and DELIM-RE in VAR or DEFAULT for no match." ;; Use LastChanged... to really get information from SVN. (defconst rst-svn-rev (rst-extract-version "\\$" "LastChangedRevision: " "[0-9]+" " " - "$LastChangedRevision: 7963 $") + "$LastChangedRevision: 8011 $") "The SVN revision of this file. SVN revision is the upstream (docutils) revision.") (defconst rst-svn-timestamp (rst-extract-version "\\$" "LastChangedDate: " ".+?+" " " - "$LastChangedDate: 2016-07-31 13:13:21 +0200 (Sun, 31 Jul 2016) $") + "$LastChangedDate: 2017-01-03 22:56:17 +0100 (Tue, 03 Jan 2017) $") "The SVN time stamp of this file.") ;; Maintained by the release process. (defconst rst-official-version (rst-extract-version "%" "OfficialVersion: " "[0-9]+\\(?:\\.[0-9]+\\)+" " " - "%OfficialVersion: 1.5.0 %") + "%OfficialVersion: 1.5.1 %") "Official version of the package.") (defconst rst-official-cvs-rev (rst-extract-version "[%$]" "Revision: " "[0-9]+\\(?:\\.[0-9]+\\)+" " " - "%Revision: 1.600 %") + "$Revision: 1.1058.2.3 $") "CVS revision of this file in the official version.") (defconst rst-version @@ -278,6 +296,7 @@ in parentheses follows the development revision and the time stamp.") ("1.4.1" . "24.5") ("1.4.2" . "24.5") ("1.5.0" . "26.1") + ("1.5.1" . "26.2") )) (unless (assoc rst-official-version rst-package-emacs-version-alist) @@ -368,6 +387,7 @@ in parentheses follows the development revision and the time stamp.") ;; Various starts (bul-sta bul-tag bli-sfx) ; Start of a bulleted item. + (bul-beg lin-beg bul-sta) ; A bullet item at the beginning of a line. ;; Explicit markup tag (`exm') (exm-tag "\\.\\.") @@ -571,34 +591,34 @@ referenceable group (\"\\(...\\)\"). After interpretation of ARGS the results are concatenated as for `:seq'." - (apply 'concat + (apply #'concat (mapcar - (lambda (re) - (cond - ((stringp re) - re) - ((symbolp re) - (cadr (assoc re rst-re-alist))) - ((characterp re) - (regexp-quote (char-to-string re))) - ((listp re) - (let ((nested - (mapcar (lambda (elt) - (rst-re elt)) - (cdr re)))) - (cond - ((eq (car re) :seq) - (mapconcat 'identity nested "")) - ((eq (car re) :shy) - (concat "\\(?:" (mapconcat 'identity nested "") "\\)")) - ((eq (car re) :grp) - (concat "\\(" (mapconcat 'identity nested "") "\\)")) - ((eq (car re) :alt) - (concat "\\(?:" (mapconcat 'identity nested "\\|") "\\)")) - (t - (error "Unknown list car: %s" (car re)))))) - (t - (error "Unknown object type for building regex: %s" re)))) + #'(lambda (re) + (cond + ((stringp re) + re) + ((symbolp re) + (cadr (assoc re rst-re-alist))) + ((characterp re) + (regexp-quote (char-to-string re))) + ((listp re) + (let ((nested + (mapcar (lambda (elt) + (rst-re elt)) + (cdr re)))) + (cond + ((eq (car re) :seq) + (mapconcat #'identity nested "")) + ((eq (car re) :shy) + (concat "\\(?:" (mapconcat #'identity nested "") "\\)")) + ((eq (car re) :grp) + (concat "\\(" (mapconcat #'identity nested "") "\\)")) + ((eq (car re) :alt) + (concat "\\(?:" (mapconcat #'identity nested "\\|") "\\)")) + (t + (error "Unknown list car: %s" (car re)))))) + (t + (error "Unknown object type for building regex: %s" re)))) args))) ;; FIXME: Remove circular dependency between `rst-re' and `rst-re-alist'. @@ -610,7 +630,7 @@ After interpretation of ARGS the results are concatenated as for (dolist (re rst-re-alist-def rst-re-alist) (setq rst-re-alist (nconc rst-re-alist - (list (list (car re) (apply 'rst-re (cdr re)))))))) + (list (list (car re) (apply #'rst-re (cdr re)))))))) "Alist mapping symbols from `rst-re-alist-def' to regex strings.")) @@ -630,9 +650,9 @@ After interpretation of ARGS the results are concatenated as for ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Class rst-Ado -(defstruct +(cl-defstruct (rst-Ado - (:constructor nil) ;; Prevent creating unchecked values. + (:constructor nil) ; Prevent creating unchecked values. ;; Construct a transition. (:constructor rst-Ado-new-transition @@ -682,61 +702,45 @@ This type is immutable." ;; testcover: ok. "Validate CHAR to be a valid adornment character. Return CHAR if so or signal an error otherwise." - (cond - ((not (characterp char)) - (signal 'wrong-type-argument (list 'characterp char))) - ((memq char rst-adornment-chars) - char) - (t - (signal 'args-out-of-range - (list (format - "Character must be a valid adornment character, not '%s'" - char)))))) + (cl-check-type char character) + (cl-check-type char (satisfies + (lambda (c) + (memq c rst-adornment-chars))) + "Character must be a valid adornment character") + char) ;; Public methods (defun rst-Ado-is-transition (self) ;; testcover: ok. "Return non-nil if SELF is a transition adornment." - (unless (rst-Ado-p self) - (signal 'wrong-type-argument - (list 'rst-Ado-p self))) + (cl-check-type self rst-Ado) (eq (rst-Ado--style self) 'transition)) (defun rst-Ado-is-section (self) ;; testcover: ok. "Return non-nil if SELF is a section adornment." - (unless (rst-Ado-p self) - (signal 'wrong-type-argument - (list 'rst-Ado-p self))) + (cl-check-type self rst-Ado) (not (rst-Ado-is-transition self))) (defun rst-Ado-is-simple (self) ;; testcover: ok. "Return non-nil if SELF is a simple section adornment." - (unless (rst-Ado-p self) - (signal 'wrong-type-argument - (list 'rst-Ado-p self))) + (cl-check-type self rst-Ado) (eq (rst-Ado--style self) 'simple)) (defun rst-Ado-is-over-and-under (self) ;; testcover: ok. "Return non-nil if SELF is a over-and-under section adornment." - (unless (rst-Ado-p self) - (signal 'wrong-type-argument - (list 'rst-Ado-p self))) + (cl-check-type self rst-Ado) (eq (rst-Ado--style self) 'over-and-under)) (defun rst-Ado-equal (self other) ;; testcover: ok. "Return non-nil when SELF and OTHER are equal." + (cl-check-type self rst-Ado) + (cl-check-type other rst-Ado) (cond - ((not (rst-Ado-p self)) - (signal 'wrong-type-argument - (list 'rst-Ado-p self))) - ((not (rst-Ado-p other)) - (signal 'wrong-type-argument - (list 'rst-Ado-p other))) ((not (eq (rst-Ado--style self) (rst-Ado--style other))) nil) ((rst-Ado-is-transition self)) @@ -744,22 +748,19 @@ Return CHAR if so or signal an error otherwise." (defun rst-Ado-position (self ados) ;; testcover: ok. - "Return position of of SELF in ADOS or nil." - (unless (rst-Ado-p self) - (signal 'wrong-type-argument - (list 'rst-Ado-p self))) - (lexical-let ((ado self)) ;; Create closure. - (rst-position-if (function (lambda (e) - (rst-Ado-equal ado e))) - ados))) + "Return position of SELF in ADOS or nil." + (cl-check-type self rst-Ado) + (cl-position-if #'(lambda (e) + (rst-Ado-equal self e)) + ados)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Class rst-Hdr -(defstruct +(cl-defstruct (rst-Hdr - (:constructor nil) ;; Prevent creating unchecked values. + (:constructor nil) ; Prevent creating unchecked values. ;; Construct while all parameters must be valid. (:constructor rst-Hdr-new @@ -784,7 +785,7 @@ Return CHAR if so or signal an error otherwise." &aux (ado (rst-Hdr--validate-ado (rst-Ado-new-invert ado-arg))) (indent (rst-Hdr--validate-indent indent-arg ado t)))) - (:copier rst-Hdr-copy)) ;; Not really needed for an immutable type. + (:copier nil)) ; Not really needed for an immutable type. "Representation of reStructuredText section header characteristics. This type is immutable." @@ -800,10 +801,8 @@ This type is immutable." "Validate INDENT to be a valid indentation for ADO. Return INDENT if so or signal an error otherwise. If LAX don't signal an error and return a valid indent." + (cl-check-type indent integer) (cond - ((not (integerp indent)) - (signal 'wrong-type-argument - (list 'integerp 'null indent))) ((zerop indent) indent) ((rst-Ado-is-simple ado) @@ -816,33 +815,34 @@ signal an error and return a valid indent." 0 (signal 'args-out-of-range '("Indentation must not be negative")))) - (indent))) ;; Implicitly over-and-under. + ;; Implicitly over-and-under. + (indent))) (defun rst-Hdr--validate-ado (ado) ;; testcover: ok. "Validate ADO to be a valid adornment. Return ADO if so or signal an error otherwise." + (cl-check-type ado rst-Ado) (cond - ((not (rst-Ado-p ado)) - (signal 'wrong-type-argument - (list 'rst-Ado-p ado))) ((rst-Ado-is-transition ado) (signal 'args-out-of-range '("Adornment for header must not be transition."))) - (t - ado))) + (ado))) ;; Public class methods +(defvar rst-preferred-adornments) ; Forward declaration. + (defun rst-Hdr-preferred-adornments () ;; testcover: ok. "Return preferred adornments as list of `rst-Hdr'." - (mapcar (lambda (el) - (rst-Hdr-new-lax - (if (eq (cadr el) 'over-and-under) - (rst-Ado-new-over-and-under (car el)) - (rst-Ado-new-simple (car el))) - (caddr el))) + (mapcar (cl-function + (lambda ((character style indent)) + (rst-Hdr-new-lax + (if (eq style 'over-and-under) + (rst-Ado-new-over-and-under character) + (rst-Ado-new-simple character)) + indent))) rst-preferred-adornments)) ;; Public methods @@ -850,238 +850,238 @@ Return ADO if so or signal an error otherwise." (defun rst-Hdr-member-ado (self hdrs) ;; testcover: ok. "Return sublist of HDRS whose car's adornment equals that of SELF or nil." - (unless (rst-Hdr-p self) - (signal 'wrong-type-argument - (list 'rst-Hdr-p self))) - (let ((pos (rst-Ado-position (rst-Hdr-ado self) (rst-Hdr-ado-map hdrs)))) - (and pos (nthcdr pos hdrs)))) + (cl-check-type self rst-Hdr) + (let ((ado (rst-Hdr-ado self))) + (cl-member-if #'(lambda (hdr) + (rst-Ado-equal ado (rst-Hdr-ado hdr))) + hdrs))) (defun rst-Hdr-ado-map (selves) ;; testcover: ok. "Return `rst-Ado' list extracted from elements of SELVES." - (mapcar 'rst-Hdr-ado selves)) + (mapcar #'rst-Hdr-ado selves)) (defun rst-Hdr-get-char (self) ;; testcover: ok. "Return character of the adornment of SELF." - (unless (rst-Hdr-p self) - (signal 'wrong-type-argument - (list 'rst-Hdr-p self))) + (cl-check-type self rst-Hdr) (rst-Ado-char (rst-Hdr-ado self))) (defun rst-Hdr-is-over-and-under (self) ;; testcover: ok. "Return non-nil if SELF is a over-and-under section header." - (unless (rst-Hdr-p self) - (signal 'wrong-type-argument - (list 'rst-Hdr-p self))) + (cl-check-type self rst-Hdr) (rst-Ado-is-over-and-under (rst-Hdr-ado self))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Class rst-Ttl -(defstruct +(cl-defstruct (rst-Ttl - (:constructor nil) ;; Prevent creating unchecked values. + (:constructor nil) ; Prevent creating unchecked values. ;; Construct with valid parameters for all attributes. - (:constructor - rst-Ttl-new + (:constructor ; Private constructor + rst-Ttl--new (ado-arg match-arg indent-arg text-arg - &optional - hdr-arg - level-arg &aux (ado (rst-Ttl--validate-ado ado-arg)) (match (rst-Ttl--validate-match match-arg ado)) (indent (rst-Ttl--validate-indent indent-arg ado)) (text (rst-Ttl--validate-text text-arg ado)) - (hdr (and hdr-arg (rst-Ttl--validate-hdr hdr-arg ado indent))) - (level (and level-arg (rst-Ttl--validate-level level-arg))))) - (:copier rst-Ttl-copy)) - "Representation of a reStructuredText section header as found in the buffer. -This type gathers information about an adorned part in the -buffer. Thus only the basic attributes are immutable. Although -the remaining attributes are `setf'-able the respective setters -should be used." + (hdr (condition-case nil + (rst-Hdr-new ado indent) + (error nil))))) + (:copier nil)) ; Not really needed for an immutable type. + "Representation of a reStructuredText section header as found in a buffer. +This type gathers information about an adorned part in the buffer. + +This type is immutable." ;; The adornment characteristics or nil for a title candidate. (ado nil :read-only t) - ;; The match-data for `ado' as returned by `match-data'. Match group 0 - ;; matches the whole construct. Match group 1 matches the overline adornment - ;; if present. Match group 2 matches the section title text or the - ;; transition. Match group 3 matches the underline adornment. + ;; The match-data for `ado' in a form similarly returned by `match-data' (but + ;; not necessarily with markers in buffers). Match group 0 matches the whole + ;; construct. Match group 1 matches the overline adornment if present. + ;; Match group 2 matches the section title text or the transition. Match + ;; group 3 matches the underline adornment. (match nil :read-only t) ;; An indentation found for the title line or nil for a transition. (indent nil :read-only t) ;; The text of the title or nil for a transition. (text nil :read-only t) ;; The header characteristics if it is a valid section header. - (hdr nil) - ;; The hierarchical level of the section header starting with 0. - (level nil)) + (hdr nil :read-only t) + ;; FIXME refactoring: Should have an attribute `buffer' for the buffer this + ;; title is found in. This breaks lots and lots of tests. + ;; However, with private constructor they may not be + ;; necessary any more. In case it is really a buffer then + ;; also `match' could be real data from `match-data' which + ;; contains markers instead of integers. + ) ;; Private class methods (defun rst-Ttl--validate-ado (ado) ;; testcover: ok. "Return valid ADO or signal error." - (unless (or (null ado) (rst-Ado-p ado)) - (signal 'wrong-type-argument - (list 'null 'rst-Ado-p ado))) + (cl-check-type ado (or null rst-Ado)) ado) (defun rst-Ttl--validate-match (match ado) ;; testcover: ok. "Return valid MATCH matching ADO or signal error." - (unless (listp match) - (signal 'wrong-type-argument - (list 'listp match))) - (unless (equal (length match) 8) - (signal 'args-out-of-range - '("Match data must consist of exactly 8 buffer positions."))) - (mapcar (lambda (pos) - (unless (or (null pos) (integer-or-marker-p pos)) - (signal 'wrong-type-argument - (list 'integer-or-marker-p 'null pos)))) - match) - (unless (and (integer-or-marker-p (nth 0 match)) - (integer-or-marker-p (nth 1 match))) - (signal 'args-out-of-range - '("First two elements of match data must be buffer positions."))) - (cond - ((null ado) - (unless (and (null (nth 2 match)) - (null (nth 3 match)) - (integer-or-marker-p (nth 4 match)) - (integer-or-marker-p (nth 5 match)) - (null (nth 6 match)) - (null (nth 7 match))) - (signal 'args-out-of-range - '("For a title candidate exactly the third match pair must be set.")))) - ((rst-Ado-is-transition ado) - (unless (and (null (nth 2 match)) - (null (nth 3 match)) - (integer-or-marker-p (nth 4 match)) - (integer-or-marker-p (nth 5 match)) - (null (nth 6 match)) - (null (nth 7 match))) + (cl-check-type ado (or null rst-Ado)) + (cl-check-type match list) + (cl-check-type match (satisfies (lambda (m) + (equal (length m) 8))) + "Match data must consist of exactly 8 buffer positions.") + (dolist (pos match) + (cl-check-type pos (or null integer-or-marker))) + (cl-destructuring-bind (all-beg all-end + ovr-beg ovr-end + txt-beg txt-end + und-beg und-end) match + (unless (and (integer-or-marker-p all-beg) (integer-or-marker-p all-end)) (signal 'args-out-of-range - '("For a transition exactly the third match pair must be set.")))) - ((rst-Ado-is-simple ado) - (unless (and (null (nth 2 match)) - (null (nth 3 match)) - (integer-or-marker-p (nth 4 match)) - (integer-or-marker-p (nth 5 match)) - (integer-or-marker-p (nth 6 match)) - (integer-or-marker-p (nth 7 match))) - (signal 'args-out-of-range - '("For a simple section adornment exactly the third and fourth match pair must be set.")))) - (t ;; over-and-under - (unless (and (integer-or-marker-p (nth 2 match)) - (integer-or-marker-p (nth 3 match)) - (integer-or-marker-p (nth 4 match)) - (integer-or-marker-p (nth 5 match)) - (or (null (nth 6 match)) (integer-or-marker-p (nth 6 match))) - (or (null (nth 7 match)) (integer-or-marker-p (nth 7 match)))) - (signal 'args-out-of-range - '("For a over-and-under section adornment all match pairs must be set."))))) + '("First two elements of match data must be buffer positions."))) + (cond + ((null ado) + (unless (and (null ovr-beg) (null ovr-end) + (integer-or-marker-p txt-beg) (integer-or-marker-p txt-end) + (null und-beg) (null und-end)) + (signal 'args-out-of-range + '("For a title candidate exactly the third match pair must be set.")))) + ((rst-Ado-is-transition ado) + (unless (and (null ovr-beg) (null ovr-end) + (integer-or-marker-p txt-beg) (integer-or-marker-p txt-end) + (null und-beg) (null und-end)) + (signal 'args-out-of-range + '("For a transition exactly the third match pair must be set.")))) + ((rst-Ado-is-simple ado) + (unless (and (null ovr-beg) (null ovr-end) + (integer-or-marker-p txt-beg) (integer-or-marker-p txt-end) + (integer-or-marker-p und-beg) (integer-or-marker-p und-end)) + (signal 'args-out-of-range + '("For a simple section adornment exactly the third and fourth match pair must be set.")))) + (t ; over-and-under + (unless (and (integer-or-marker-p ovr-beg) (integer-or-marker-p ovr-end) + (integer-or-marker-p txt-beg) (integer-or-marker-p txt-end) + (or (null und-beg) (integer-or-marker-p und-beg)) + (or (null und-end) (integer-or-marker-p und-end))) + (signal 'args-out-of-range + '("For a over-and-under section adornment all match pairs must be set.")))))) match) (defun rst-Ttl--validate-indent (indent ado) ;; testcover: ok. "Return valid INDENT for ADO or signal error." (if (and ado (rst-Ado-is-transition ado)) - (unless (null indent) - (signal 'args-out-of-range - '("Indent for a transition must be nil."))) - (unless (integerp indent) - (signal 'wrong-type-argument - (list 'integerp indent))) - (unless (>= indent 0) - (signal 'args-out-of-range - '("Indent for a section header must be non-negative.")))) + (cl-check-type indent null + "Indent for a transition must be nil.") + (cl-check-type indent (integer 0 *) + "Indent for a section header must be non-negative.")) indent) -(defun rst-Ttl--validate-hdr (hdr ado indent) - ;; testcover: ok. - "Return valid HDR in relation to ADO and INDENT or signal error." - (unless (rst-Hdr-p hdr) - (signal 'wrong-type-argument - (list 'rst-Hdr-p hdr))) - (unless (rst-Ado-equal (rst-Hdr-ado hdr) ado) - (signal 'args-out-of-range - '("Basic adornment and adornment in header must match."))) - (unless (equal (rst-Hdr-indent hdr) indent) - (signal 'args-out-of-range - '("Basic indent and indent in header must match."))) - hdr) - (defun rst-Ttl--validate-text (text ado) ;; testcover: ok. "Return valid TEXT for ADO or signal error." (if (and ado (rst-Ado-is-transition ado)) - (unless (null text) - (signal 'args-out-of-range - '("Transitions may not have title text."))) - (unless (stringp text) - (signal 'wrong-type-argument - (list 'stringp text)))) + (cl-check-type text null + "Transitions may not have title text.") + (cl-check-type text string)) text) -(defun rst-Ttl--validate-level (level) +;; Public class methods + +(defun rst-Ttl-from-buffer (ado beg-ovr beg-txt beg-und txt) ;; testcover: ok. - "Return valid LEVEL or signal error." - (unless (integerp level) - (signal 'wrong-type-argument - (list 'integerp level))) - (unless (>= level 0) - (signal 'args-out-of-range - '("Level must be non-negative."))) - level) + "Return a `rst-Ttl' constructed from information in the current buffer. +ADO is the adornment or nil for a title candidate. BEG-OVR and +BEG-UND are the starting points of the overline or underline, +respectively. They may be nil if the respective thing is missing. +BEG-TXT is the beginning of the title line or the transition and +must be given. The end of the line is used as the end point. TXT +is the title text or nil. If TXT is given the indendation of the +line containing BEG-TXT is used as indentation. Match group 0 is +derived from the remaining information." + (cl-check-type beg-txt integer-or-marker) + (save-excursion + (let ((end-ovr (when beg-ovr + (goto-char beg-ovr) + (line-end-position))) + (end-txt (progn + (goto-char beg-txt) + (line-end-position))) + (end-und (when beg-und + (goto-char beg-und) + (line-end-position))) + (ind (when txt + (goto-char beg-txt) + (current-indentation)))) + (rst-Ttl--new ado + (list + (or beg-ovr beg-txt) (or end-und end-txt) + beg-ovr end-ovr + beg-txt end-txt + beg-und end-und) + ind txt)))) ;; Public methods -(defun rst-Ttl-evaluate-hdr (self) - ;; testcover: ok. - "Check for `ado' and `indent' in SELF forming a valid `rst-Hdr'. -Set and return it or nil if no valid `rst-Hdr' can be formed." - (setf (rst-Ttl-hdr self) - (condition-case nil - (rst-Hdr-new (rst-Ttl-ado self) (rst-Ttl-indent self)) - (error nil)))) - -(defun rst-Ttl-set-level (self level) - ;; testcover: ok. - "In SELF set and return LEVEL or nil if invalid." - (setf (rst-Ttl-level self) - (rst-Ttl--validate-level level))) - (defun rst-Ttl-get-title-beginning (self) ;; testcover: ok. "Return position of beginning of title text of SELF. This position should always be at the start of a line." + (cl-check-type self rst-Ttl) (nth 4 (rst-Ttl-match self))) (defun rst-Ttl-get-beginning (self) ;; testcover: ok. "Return position of beginning of whole SELF." + (cl-check-type self rst-Ttl) (nth 0 (rst-Ttl-match self))) (defun rst-Ttl-get-end (self) ;; testcover: ok. "Return position of end of whole SELF." + (cl-check-type self rst-Ttl) (nth 1 (rst-Ttl-match self))) +(defun rst-Ttl-is-section (self) + ;; testcover: ok. + "Return non-nil if SELF is a section header or candidate." + (cl-check-type self rst-Ttl) + (rst-Ttl-text self)) + +(defun rst-Ttl-is-candidate (self) + ;; testcover: ok. + "Return non-nil if SELF is a candidate for a section header." + (cl-check-type self rst-Ttl) + (not (rst-Ttl-ado self))) + +(defun rst-Ttl-contains (self position) + "Return whether SELF contain POSITION. +Return 0 if SELF contains POSITION, < 0 if SELF ends before +POSITION and > 0 if SELF starts after position." + (cl-check-type self rst-Ttl) + (cl-check-type position integer-or-marker) + (cond + ((< (nth 1 (rst-Ttl-match self)) position) + -1) + ((> (nth 0 (rst-Ttl-match self)) position) + +1) + (0))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Class rst-Stn -(defstruct +(cl-defstruct (rst-Stn - (:constructor nil) ;; Prevent creating unchecked values. + (:constructor nil) ; Prevent creating unchecked values. ;; Construct while all parameters must be valid. (:constructor rst-Stn-new @@ -1102,45 +1102,33 @@ This type is immutable." (level nil :read-only t) ;; The list of children of the node. (children nil :read-only t)) +;; FIXME refactoring: Should have an attribute `buffer' for the buffer this +;; title is found in. Or use `rst-Ttl-buffer'. ;; Private class methods (defun rst-Stn--validate-ttl (ttl) ;; testcover: ok. "Return valid TTL or signal error." - (unless (or (null ttl) (rst-Ttl-p ttl)) - (signal 'wrong-type-argument - (list 'null 'rst-Ttl-p ttl))) + (cl-check-type ttl (or null rst-Ttl)) ttl) (defun rst-Stn--validate-level (level ttl) ;; testcover: ok. "Return valid LEVEL for TTL or signal error." - (unless (integerp level) - (signal 'wrong-type-argument - (list 'integerp level))) - (when ttl - (unless (or (not (rst-Ttl-level ttl)) - (equal (rst-Ttl-level ttl) level)) - (signal 'args-out-of-range - '("A title must have correct level or none at all."))) - (when (< level 0) - ;; testcover: Never reached because a title may not have a negative level - (signal 'args-out-of-range - '("Top level node must not have a title.")))) + (cl-check-type level integer) + (when (and ttl (< level 0)) + ;; testcover: Never reached because a title may not have a negative level + (signal 'args-out-of-range + '("Top level node must not have a title."))) level) (defun rst-Stn--validate-children (children ttl) ;; testcover: ok. "Return valid CHILDREN for TTL or signal error." - (unless (listp children) - (signal 'wrong-type-argument - (list 'listp children))) - (mapcar (lambda (child) - (unless (rst-Stn-p child) - (signal 'wrong-type-argument - (list 'rst-Stn-p child)))) - children) + (cl-check-type children list) + (dolist (child children) + (cl-check-type child rst-Stn)) (unless (or ttl children) (signal 'args-out-of-range '("A missing node must have children."))) @@ -1152,9 +1140,7 @@ This type is immutable." ;; testcover: ok. "Return the beginning of the title of SELF. Handles missing node properly." - (unless (rst-Stn-p self) - (signal 'wrong-type-argument - (list 'rst-Stn-p self))) + (cl-check-type self rst-Stn) (let ((ttl (rst-Stn-ttl self))) (if ttl (rst-Ttl-get-title-beginning ttl) @@ -1164,9 +1150,7 @@ Handles missing node properly." ;; testcover: ok. "Return title text of SELF or DEFAULT if SELF is a missing node. For a missing node and no DEFAULT given return a standard title text." - (unless (rst-Stn-p self) - (signal 'wrong-type-argument - (list 'rst-Stn-p self))) + (cl-check-type self rst-Stn) (let ((ttl (rst-Stn-ttl self))) (cond (ttl @@ -1177,9 +1161,7 @@ For a missing node and no DEFAULT given return a standard title text." (defun rst-Stn-is-top (self) ;; testcover: ok. "Return non-nil if SELF is a top level node." - (unless (rst-Stn-p self) - (signal 'wrong-type-argument - (list 'rst-Stn-p self))) + (cl-check-type self rst-Stn) (< (rst-Stn-level self) 0)) @@ -1203,13 +1185,13 @@ as well but give an additional message." (forwarder-function (intern forwarder-function-name))) (unless (fboundp forwarder-function) (defalias forwarder-function - (lexical-let ((key key) (def def)) - (lambda () - (interactive) - (call-interactively def) - (message "[Deprecated use of key %s; use key %s instead]" - (key-description (this-command-keys)) - (key-description key)))) + (lambda () + (interactive) + (call-interactively def) + (message "[Deprecated use of key %s; use key %s instead]" + (key-description (this-command-keys)) + (key-description key))) + ;; FIXME: In Emacs-25 we could use (:documentation ...) instead. (format "Deprecated binding for %s, use \\[%s] instead." def def))) (dolist (dep-key deprecated) @@ -1220,40 +1202,40 @@ as well but give an additional message." (let ((map (make-sparse-keymap))) ;; \C-c is the general keymap. - (rst-define-key map [?\C-c ?\C-h] 'describe-prefix-bindings) + (rst-define-key map [?\C-c ?\C-h] #'describe-prefix-bindings) ;; ;; Section Adornments ;; ;; The adjustment function that adorns or rotates a section title. - (rst-define-key map [?\C-c ?\C-=] 'rst-adjust [?\C-c ?\C-a t]) - (rst-define-key map [?\C-=] 'rst-adjust) ; Does not work on macOS and - ; on consoles. + (rst-define-key map [?\C-c ?\C-=] #'rst-adjust [?\C-c ?\C-a t]) + (rst-define-key map [?\C-=] #'rst-adjust) ; Does not work on macOS and + ; on consoles. ;; \C-c \C-a is the keymap for adornments. - (rst-define-key map [?\C-c ?\C-a ?\C-h] 'describe-prefix-bindings) + (rst-define-key map [?\C-c ?\C-a ?\C-h] #'describe-prefix-bindings) ;; Another binding which works with all types of input. - (rst-define-key map [?\C-c ?\C-a ?\C-a] 'rst-adjust) + (rst-define-key map [?\C-c ?\C-a ?\C-a] #'rst-adjust) ;; Display the hierarchy of adornments implied by the current document ;; contents. - (rst-define-key map [?\C-c ?\C-a ?\C-d] 'rst-display-hdr-hierarchy) + (rst-define-key map [?\C-c ?\C-a ?\C-d] #'rst-display-hdr-hierarchy) ;; Homogenize the adornments in the document. - (rst-define-key map [?\C-c ?\C-a ?\C-s] 'rst-straighten-sections + (rst-define-key map [?\C-c ?\C-a ?\C-s] #'rst-straighten-sections [?\C-c ?\C-s]) ;; ;; Section Movement and Selection ;; ;; Mark the subsection where the cursor is. - (rst-define-key map [?\C-\M-h] 'rst-mark-section + (rst-define-key map [?\C-\M-h] #'rst-mark-section ;; Same as mark-defun sgml-mark-current-element. [?\C-c ?\C-m]) ;; Move backward/forward between section titles. ;; FIXME: Also bind similar to outline mode. - (rst-define-key map [?\C-\M-a] 'rst-backward-section + (rst-define-key map [?\C-\M-a] #'rst-backward-section ;; Same as beginning-of-defun. [?\C-c ?\C-n]) - (rst-define-key map [?\C-\M-e] 'rst-forward-section + (rst-define-key map [?\C-\M-e] #'rst-forward-section ;; Same as end-of-defun. [?\C-c ?\C-p]) @@ -1261,69 +1243,69 @@ as well but give an additional message." ;; Operating on regions ;; ;; \C-c \C-r is the keymap for regions. - (rst-define-key map [?\C-c ?\C-r ?\C-h] 'describe-prefix-bindings) + (rst-define-key map [?\C-c ?\C-r ?\C-h] #'describe-prefix-bindings) ;; Makes region a line-block. - (rst-define-key map [?\C-c ?\C-r ?\C-l] 'rst-line-block-region + (rst-define-key map [?\C-c ?\C-r ?\C-l] #'rst-line-block-region [?\C-c ?\C-d]) ;; Shift region left or right according to tabs. - (rst-define-key map [?\C-c ?\C-r tab] 'rst-shift-region + (rst-define-key map [?\C-c ?\C-r tab] #'rst-shift-region [?\C-c ?\C-r t] [?\C-c ?\C-l t]) ;; ;; Operating on lists ;; ;; \C-c \C-l is the keymap for lists. - (rst-define-key map [?\C-c ?\C-l ?\C-h] 'describe-prefix-bindings) + (rst-define-key map [?\C-c ?\C-l ?\C-h] #'describe-prefix-bindings) ;; Makes paragraphs in region as a bullet list. - (rst-define-key map [?\C-c ?\C-l ?\C-b] 'rst-bullet-list-region + (rst-define-key map [?\C-c ?\C-l ?\C-b] #'rst-bullet-list-region [?\C-c ?\C-b]) ;; Makes paragraphs in region as a enumeration. - (rst-define-key map [?\C-c ?\C-l ?\C-e] 'rst-enumerate-region + (rst-define-key map [?\C-c ?\C-l ?\C-e] #'rst-enumerate-region [?\C-c ?\C-e]) ;; Converts bullets to an enumeration. - (rst-define-key map [?\C-c ?\C-l ?\C-c] 'rst-convert-bullets-to-enumeration + (rst-define-key map [?\C-c ?\C-l ?\C-c] #'rst-convert-bullets-to-enumeration [?\C-c ?\C-v]) ;; Make sure that all the bullets in the region are consistent. - (rst-define-key map [?\C-c ?\C-l ?\C-s] 'rst-straighten-bullets-region + (rst-define-key map [?\C-c ?\C-l ?\C-s] #'rst-straighten-bullets-region [?\C-c ?\C-w]) ;; Insert a list item. - (rst-define-key map [?\C-c ?\C-l ?\C-i] 'rst-insert-list) + (rst-define-key map [?\C-c ?\C-l ?\C-i] #'rst-insert-list) ;; ;; Table-of-Contents Features ;; ;; \C-c \C-t is the keymap for table of contents. - (rst-define-key map [?\C-c ?\C-t ?\C-h] 'describe-prefix-bindings) + (rst-define-key map [?\C-c ?\C-t ?\C-h] #'describe-prefix-bindings) ;; Enter a TOC buffer to view and move to a specific section. - (rst-define-key map [?\C-c ?\C-t ?\C-t] 'rst-toc) + (rst-define-key map [?\C-c ?\C-t ?\C-t] #'rst-toc) ;; Insert a TOC here. - (rst-define-key map [?\C-c ?\C-t ?\C-i] 'rst-toc-insert + (rst-define-key map [?\C-c ?\C-t ?\C-i] #'rst-toc-insert [?\C-c ?\C-i]) ;; Update the document's TOC (without changing the cursor position). - (rst-define-key map [?\C-c ?\C-t ?\C-u] 'rst-toc-update + (rst-define-key map [?\C-c ?\C-t ?\C-u] #'rst-toc-update [?\C-c ?\C-u]) - ;; Go to the section under the cursor (cursor must be in TOC). - (rst-define-key map [?\C-c ?\C-t ?\C-j] 'rst-goto-section + ;; Go to the section under the cursor (cursor must be in internal TOC). + (rst-define-key map [?\C-c ?\C-t ?\C-j] #'rst-toc-follow-link [?\C-c ?\C-f]) ;; ;; Converting Documents from Emacs ;; ;; \C-c \C-c is the keymap for compilation. - (rst-define-key map [?\C-c ?\C-c ?\C-h] 'describe-prefix-bindings) + (rst-define-key map [?\C-c ?\C-c ?\C-h] #'describe-prefix-bindings) ;; Run one of two pre-configured toolset commands on the document. - (rst-define-key map [?\C-c ?\C-c ?\C-c] 'rst-compile + (rst-define-key map [?\C-c ?\C-c ?\C-c] #'rst-compile [?\C-c ?1]) - (rst-define-key map [?\C-c ?\C-c ?\C-a] 'rst-compile-alt-toolset + (rst-define-key map [?\C-c ?\C-c ?\C-a] #'rst-compile-alt-toolset [?\C-c ?2]) ;; Convert the active region to pseudo-xml using the docutils tools. - (rst-define-key map [?\C-c ?\C-c ?\C-x] 'rst-compile-pseudo-region + (rst-define-key map [?\C-c ?\C-c ?\C-x] #'rst-compile-pseudo-region [?\C-c ?3]) ;; Convert the current document to PDF and launch a viewer on the results. - (rst-define-key map [?\C-c ?\C-c ?\C-p] 'rst-compile-pdf-preview + (rst-define-key map [?\C-c ?\C-c ?\C-p] #'rst-compile-pdf-preview [?\C-c ?4]) ;; Convert the current document to S5 slides and view in a web browser. - (rst-define-key map [?\C-c ?\C-c ?\C-s] 'rst-compile-slides-preview + (rst-define-key map [?\C-c ?\C-c ?\C-s] #'rst-compile-slides-preview [?\C-c ?5]) map) @@ -1333,7 +1315,8 @@ This inherits from Text mode.") ;; Abbrevs. (define-abbrev-table 'rst-mode-abbrev-table - (mapcar (lambda (x) (append x '(nil 0 system))) + (mapcar #'(lambda (x) + (append x '(nil 0 system))) '(("contents" ".. contents::\n..\n ") ("con" ".. contents::\n..\n ") ("cont" "[...]") @@ -1381,6 +1364,7 @@ The hook for `text-mode' is run before this one." (require 'newcomment) (defvar electric-pair-pairs) +(defvar electric-indent-inhibit) ;; Use rst-mode for *.rst and *.rest files. Many ReStructured-Text files ;; use *.txt, but this is too generic to be set as a default. @@ -1411,10 +1395,10 @@ highlighting. (:seq hws-tag par-tag- bli-sfx)))) ;; Indenting and filling. - (setq-local indent-line-function 'rst-indent-line) + (setq-local indent-line-function #'rst-indent-line) (setq-local adaptive-fill-mode t) (setq-local adaptive-fill-regexp (rst-re 'hws-tag 'par-tag- "?" 'hws-tag)) - (setq-local adaptive-fill-function 'rst-adaptive-fill) + (setq-local adaptive-fill-function #'rst-adaptive-fill) (setq-local fill-paragraph-handle-comment nil) ;; Comments. @@ -1430,18 +1414,18 @@ highlighting. ;; Commenting in reStructuredText is very special so use our own set of ;; functions. - (setq-local comment-line-break-function 'rst-comment-line-break) - (setq-local comment-indent-function 'rst-comment-indent) - (setq-local comment-insert-comment-function 'rst-comment-insert-comment) - (setq-local comment-region-function 'rst-comment-region) - (setq-local uncomment-region-function 'rst-uncomment-region) + (setq-local comment-line-break-function #'rst-comment-line-break) + (setq-local comment-indent-function #'rst-comment-indent) + (setq-local comment-insert-comment-function #'rst-comment-insert-comment) + (setq-local comment-region-function #'rst-comment-region) + (setq-local uncomment-region-function #'rst-uncomment-region) (setq-local electric-pair-pairs '((?\" . ?\") (?\* . ?\*) (?\` . ?\`))) ;; Imenu and which function. ;; FIXME: Check documentation of `which-function' for alternative ways to ;; determine the current function name. - (setq-local imenu-create-index-function 'rst-imenu-create-index) + (setq-local imenu-create-index-function #'rst-imenu-create-index) ;; Font lock. (setq-local font-lock-defaults @@ -1449,7 +1433,7 @@ highlighting. t nil nil nil (font-lock-multiline . t) (font-lock-mark-block-function . mark-paragraph))) - (add-hook 'font-lock-extend-region-functions 'rst-font-lock-extend-region t) + (add-hook 'font-lock-extend-region-functions #'rst-font-lock-extend-region t) ;; Text after a changed line may need new fontification. (setq-local jit-lock-contextually t) @@ -1562,9 +1546,9 @@ file." :type `(repeat (group :tag "Adornment specification" (choice :tag "Adornment character" - ,@(mapcar (lambda (char) - (list 'const - :tag (char-to-string char) char)) + ,@(mapcar #'(lambda (char) + (list 'const + :tag (char-to-string char) char)) rst-adornment-chars)) (radio :tag "Adornment type" (const :tag "Overline and underline" over-and-under) @@ -1603,17 +1587,12 @@ search starts after this entry. Return nil if no new preferred ;; Start searching after the level of the previous adornment. (cdr (rst-Hdr-member-ado prev (rst-Hdr-preferred-adornments)))) (rst-Hdr-preferred-adornments)))) - (car - (rst-member-if (lambda (cand) - (not (rst-Hdr-member-ado cand seen))) - candidates)))) - -(defun rst-delete-entire-line () - "Delete the entire current line without using the `kill-ring'." - (delete-region (line-beginning-position) - (line-beginning-position 2))) + (cl-find-if #'(lambda (cand) + (not (rst-Hdr-member-ado cand seen))) + candidates))) (defun rst-update-section (hdr) + ;; testcover: ok. "Unconditionally update the style of the section header at point to HDR. If there are existing overline and/or underline from the existing adornment, they are removed before adding the @@ -1621,163 +1600,149 @@ requested adornment." (end-of-line) (let ((indent (or (rst-Hdr-indent hdr) 0)) (marker (point-marker)) - len) + new) ;; Fixup whitespace at the beginning and end of the line. - (beginning-of-line) + (1value + (rst-forward-line-strict 0)) (delete-horizontal-space) (insert (make-string indent ? )) - (end-of-line) (delete-horizontal-space) - - ;; Set the current column, we're at the end of the title line. - (setq len (+ (current-column) indent)) + (setq new (make-string (+ (current-column) indent) (rst-Hdr-get-char hdr))) ;; Remove previous line if it is an adornment. - (save-excursion - (forward-line -1) ;; FIXME testcover: Doesn't work when in first line of - ;; buffer. - (if (and (looking-at (rst-re 'ado-beg-2-1)) + ;; FIXME refactoring: Check whether this deletes `hdr' which *has* all the + ;; data necessary. + (when (and (rst-forward-line-looking-at -1 'ado-beg-2-1) ;; Avoid removing the underline of a title right above us. - (save-excursion (forward-line -1) - (not (looking-at (rst-re 'ttl-beg-1))))) - (rst-delete-entire-line))) + (not (rst-forward-line-looking-at -2 'ttl-beg-1))) + (rst-delete-entire-line -1)) ;; Remove following line if it is an adornment. - (save-excursion - (forward-line +1) ;; FIXME testcover: Doesn't work when in last line - ;; of buffer. - (if (looking-at (rst-re 'ado-beg-2-1)) - (rst-delete-entire-line)) - ;; Add a newline if we're at the end of the buffer unless it is the final - ;; empty line, for the subsequent inserting of the underline. - (if (and (= (point) (buffer-end 1)) (not (bolp))) - (newline 1))) - - ;; Insert overline. - (when (rst-Hdr-is-over-and-under hdr) - (save-excursion - (beginning-of-line) - (open-line 1) - (insert (make-string len (rst-Hdr-get-char hdr))))) + (when (rst-forward-line-looking-at +1 'ado-beg-2-1) + (rst-delete-entire-line +1)) ;; Insert underline. - (1value ;; Line has been inserted above. - (forward-line +1)) + (unless (rst-forward-line-strict +1) + ;; Normalize buffer by adding final newline. + (newline 1)) (open-line 1) - (insert (make-string len (rst-Hdr-get-char hdr))) + (insert new) + + ;; Insert overline. + (when (rst-Hdr-is-over-and-under hdr) + (1value ; Underline inserted above. + (rst-forward-line-strict -1)) + (open-line 1) + (insert new)) - (1value ;; Line has been inserted above. - (forward-line +1)) (goto-char marker))) -(defun rst-classify-adornment (adornment end) +(defun rst-classify-adornment (adornment end &optional accept-over-only) + ;; testcover: ok. "Classify adornment string for section titles and transitions. ADORNMENT is the complete adornment string as found in the buffer with optional trailing whitespace. END is the point after the last character of ADORNMENT. Return a `rst-Ttl' or nil if no -syntactically valid adornment is found." +syntactically valid adornment is found. If ACCEPT-OVER-ONLY an +overline with a missing underline is accepted as valid and +returned." (save-excursion (save-match-data (when (string-match (rst-re 'ado-beg-2-1) adornment) (goto-char end) (let* ((ado-ch (string-to-char (match-string 2 adornment))) - (ado-re (rst-re ado-ch 'adorep3-hlp)) - (end-pnt (point)) + (ado-re (rst-re ado-ch 'adorep3-hlp)) ; RE matching the + ; adornment. (beg-pnt (progn - (1value ;; No lines may be left to move. - (forward-line 0)) + (1value + (rst-forward-line-strict 0)) (point))) (nxt-emp ; Next line nonexistent or empty - (save-excursion - (or (not (zerop (forward-line 1))) - ;; FIXME testcover: Add test classifying at the end of - ;; buffer. - (looking-at (rst-re 'lin-end))))) + (not (rst-forward-line-looking-at +1 'lin-end #'not))) (prv-emp ; Previous line nonexistent or empty - (save-excursion - (or (not (zerop (forward-line -1))) - (looking-at (rst-re 'lin-end))))) + (not (rst-forward-line-looking-at -1 'lin-end #'not))) txt-blw (ttl-blw ; Title found below starting here. - (save-excursion - (and - (zerop (forward-line 1)) ;; FIXME testcover: Add test - ;; classifying at the end of - ;; buffer. - (looking-at (rst-re 'ttl-beg-1)) - (setq txt-blw (match-string-no-properties 1)) - (point)))) + (rst-forward-line-looking-at + +1 'ttl-beg-1 + #'(lambda (mtcd) + (when mtcd + (setq txt-blw (match-string-no-properties 1)) + (point))))) txt-abv (ttl-abv ; Title found above starting here. - (save-excursion - (and - (zerop (forward-line -1)) - (looking-at (rst-re 'ttl-beg-1)) - (setq txt-abv (match-string-no-properties 1)) - (point)))) + (rst-forward-line-looking-at + -1 'ttl-beg-1 + #'(lambda (mtcd) + (when mtcd + (setq txt-abv (match-string-no-properties 1)) + (point))))) (und-fnd ; Matching underline found starting here. - (save-excursion - (and ttl-blw - (zerop (forward-line 2)) ;; FIXME testcover: Add test - ;; classifying at the end of - ;; buffer. - (looking-at (rst-re ado-re 'lin-end)) - (point)))) + (and ttl-blw + (rst-forward-line-looking-at + +2 (list ado-re 'lin-end) + #'(lambda (mtcd) + (when mtcd + (point)))))) (ovr-fnd ; Matching overline found starting here. - (save-excursion - (and ttl-abv - (zerop (forward-line -2)) - (looking-at (rst-re ado-re 'lin-end)) - (point)))) - ado ind txt beg-ovr end-ovr beg-txt end-txt beg-und end-und) + (and ttl-abv + (rst-forward-line-looking-at + -2 (list ado-re 'lin-end) + #'(lambda (mtcd) + (when mtcd + (point)))))) + (und-wng ; Wrong underline found starting here. + (and ttl-blw + (not und-fnd) + (rst-forward-line-looking-at + +2 'ado-beg-2-1 + #'(lambda (mtcd) + (when mtcd + (point)))))) + (ovr-wng ; Wrong overline found starting here. + (and ttl-abv (not ovr-fnd) + (rst-forward-line-looking-at + -2 'ado-beg-2-1 + #'(lambda (mtcd) + (when (and + mtcd + ;; An adornment above may be a legal + ;; adornment for the line above - consider it + ;; a wrong overline only when it is equally + ;; long. + (equal + (length (match-string-no-properties 1)) + (length adornment))) + (point))))))) (cond ((and nxt-emp prv-emp) ;; A transition. - (setq ado (rst-Ado-new-transition) - beg-txt beg-pnt - end-txt end-pnt)) - ((or und-fnd ovr-fnd) + (rst-Ttl-from-buffer (rst-Ado-new-transition) + nil beg-pnt nil nil)) + (ovr-fnd ; Prefer overline match over underline match. ;; An overline with an underline. - (setq ado (rst-Ado-new-over-and-under ado-ch)) - (let (;; Prefer overline match over underline match. - (und-pnt (if ovr-fnd beg-pnt und-fnd)) - (ovr-pnt (if ovr-fnd ovr-fnd beg-pnt)) - (txt-pnt (if ovr-fnd ttl-abv ttl-blw))) - (goto-char ovr-pnt) - (setq beg-ovr (point) - end-ovr (line-end-position)) - (goto-char txt-pnt) - (setq beg-txt (point) - end-txt (line-end-position) - ind (current-indentation) - txt (if ovr-fnd txt-abv txt-blw)) - (goto-char und-pnt) - (setq beg-und (point) - end-und (line-end-position)))) - (ttl-abv + (rst-Ttl-from-buffer (rst-Ado-new-over-and-under ado-ch) + ovr-fnd ttl-abv beg-pnt txt-abv)) + (und-fnd + ;; An overline with an underline. + (rst-Ttl-from-buffer (rst-Ado-new-over-and-under ado-ch) + beg-pnt ttl-blw und-fnd txt-blw)) + ((and ttl-abv (not ovr-wng)) ;; An underline. - (setq ado (rst-Ado-new-simple ado-ch) - beg-und beg-pnt - end-und end-pnt) - (goto-char ttl-abv) - (setq beg-txt (point) - end-txt (line-end-position) - ind (current-indentation) - txt txt-abv)) + (rst-Ttl-from-buffer (rst-Ado-new-simple ado-ch) + nil ttl-abv beg-pnt txt-abv)) + ((and accept-over-only ttl-blw (not und-wng)) + ;; An overline with a missing underline. + (rst-Ttl-from-buffer (rst-Ado-new-over-and-under ado-ch) + beg-pnt ttl-blw nil txt-blw)) (t ;; Invalid adornment. - (setq ado nil))) - (if ado - (rst-Ttl-new ado - (list - (or beg-ovr beg-txt) - (or end-und end-txt) - beg-ovr end-ovr beg-txt end-txt beg-und end-und) - ind txt))))))) + nil))))))) (defun rst-ttl-at-point () + ;; testcover: ok. "Find a section title line around point and return its characteristics. If the point is on an adornment line find the respective title line. If the point is on an empty line check previous or next @@ -1785,89 +1750,57 @@ line whether it is a suitable title line and use it if so. If point is on a suitable title line use it. Return a `rst-Ttl' for a section header or nil if no title line is found." (save-excursion - (1value ;; No lines may be left to move. - (forward-line 0)) - (let ((orig-pnt (point)) - (orig-end (line-end-position))) - (cond - ((looking-at (rst-re 'ado-beg-2-1)) - ;; Adornment found - consider it. - (let ((char (string-to-char (match-string-no-properties 2))) - (r (rst-classify-adornment (match-string-no-properties 0) - (match-end 0)))) - (cond - ((not r) - ;; Invalid adornment - check whether this is an overline with - ;; missing underline. - (if (and - (zerop (forward-line 1)) - (looking-at (rst-re 'ttl-beg-1))) - (rst-Ttl-new (rst-Ado-new-over-and-under char) - (list orig-pnt (line-end-position) - orig-pnt orig-end - (point) (line-end-position) - nil nil) - (current-indentation) - (match-string-no-properties 1)))) - ((rst-Ado-is-transition (rst-Ttl-ado r)) - nil) - ;; Return any other classification as is. - (r)))) - ((looking-at (rst-re 'lin-end)) - ;; Empty line found - check surrounding lines for a title. - (or - (save-excursion - (if (and (zerop (forward-line -1)) - (looking-at (rst-re 'ttl-beg-1))) - (rst-Ttl-new nil - (list (point) (line-end-position) - nil nil - (point) (line-end-position) - nil nil) - (current-indentation) - (match-string-no-properties 1)))) - (save-excursion - (if (and (zerop (forward-line 1)) - (looking-at (rst-re 'ttl-beg-1))) - (rst-Ttl-new nil - (list (point) (line-end-position) - nil nil - (point) (line-end-position) - nil nil) - (current-indentation) - (match-string-no-properties 1)))))) - ((looking-at (rst-re 'ttl-beg-1)) - ;; Title line found - check for a following underline. - (let ((txt (match-string-no-properties 1))) - (or (rst-classify-adornment - (buffer-substring-no-properties - (line-beginning-position 2) (line-end-position 2)) - (line-end-position 2)) - ;; No valid adornment found. - (rst-Ttl-new nil - (list (point) (line-end-position) - nil nil - (point) (line-end-position) - nil nil) - (current-indentation) - txt)))))))) + (save-match-data + (1value + (rst-forward-line-strict 0)) + (let* (cnd-beg ; Beginning of a title candidate. + cnd-txt ; Text of a title candidate. + (cnd-fun #'(lambda (mtcd) ; Function setting title candidate data. + (when mtcd + (setq cnd-beg (match-beginning 0)) + (setq cnd-txt (match-string-no-properties 1)) + t))) + ttl) + (cond + ((looking-at (rst-re 'ado-beg-2-1)) + ;; Adornment found - consider it. + (setq ttl (rst-classify-adornment (match-string-no-properties 0) + (match-end 0) t))) + ((looking-at (rst-re 'lin-end)) + ;; Empty line found - check surrounding lines for a title. + (or + (rst-forward-line-looking-at -1 'ttl-beg-1 cnd-fun) + (rst-forward-line-looking-at +1 'ttl-beg-1 cnd-fun))) + ((looking-at (rst-re 'ttl-beg-1)) + ;; Title line found - check for a following underline. + (setq ttl (rst-forward-line-looking-at + 1 'ado-beg-2-1 + #'(lambda (mtcd) + (when mtcd + (rst-classify-adornment + (match-string-no-properties 0) (match-end 0)))))) + ;; Title candidate found if no valid adornment found. + (funcall cnd-fun (not ttl)))) + (cond + ((and ttl (rst-Ttl-is-section ttl)) + ttl) + (cnd-beg + (rst-Ttl-from-buffer nil nil cnd-beg nil cnd-txt))))))) ;; The following function and variables are used to maintain information about ;; current section adornment in a buffer local cache. Thus they can be used for ;; font-locking and manipulation commands. -(defvar rst-all-ttls-cache nil +(defvar-local rst-all-ttls-cache nil "All section adornments in the buffer as found by `rst-all-ttls'. Set to t when no section adornments were found.") -(make-variable-buffer-local 'rst-all-ttls-cache) ;; FIXME: If this variable is set to a different value font-locking of section ;; headers is wrong. -(defvar rst-hdr-hierarchy-cache nil +(defvar-local rst-hdr-hierarchy-cache nil "Section hierarchy in the buffer as determined by `rst-hdr-hierarchy'. Set to t when no section adornments were found. Value depends on `rst-all-ttls-cache'.") -(make-variable-buffer-local 'rst-hdr-hierarchy-cache) (rst-testcover-add-1value 'rst-reset-section-caches) (defun rst-reset-section-caches () @@ -1876,94 +1809,92 @@ Should be called by interactive functions which deal with sections." (setq rst-all-ttls-cache nil rst-hdr-hierarchy-cache nil)) +(defun rst-all-ttls-compute () + ;; testcover: ok. + "Return a list of `rst-Ttl' for current buffer with ascending line number." + (save-excursion + (save-match-data + (let (ttls) + (goto-char (point-min)) + ;; Iterate over all the section titles/adornments in the file. + (while (re-search-forward (rst-re 'ado-beg-2-1) nil t) + (let ((ttl (rst-classify-adornment + (match-string-no-properties 0) (point)))) + (when (and ttl (rst-Ttl-is-section ttl)) + (when (rst-Ttl-hdr ttl) + (push ttl ttls)) + (goto-char (rst-Ttl-get-end ttl))))) + (nreverse ttls))))) + (defun rst-all-ttls () "Return all the section adornments in the current buffer. Return a list of `rst-Ttl' with ascending line number. Uses and sets `rst-all-ttls-cache'." (unless rst-all-ttls-cache - (let (positions) - ;; Iterate over all the section titles/adornments in the file. - (save-excursion - (save-match-data - (goto-char (point-min)) - (while (re-search-forward (rst-re 'ado-beg-2-1) nil t) - (let ((ttl (rst-classify-adornment - (match-string-no-properties 0) (point)))) - (when (and ttl (rst-Ado-is-section (rst-Ttl-ado ttl))) - (when (rst-Ttl-evaluate-hdr ttl) - (push ttl positions)) - (goto-char (rst-Ttl-get-end ttl))))) - (setq positions (nreverse positions)) - (setq rst-all-ttls-cache (or positions t)))))) + (setq rst-all-ttls-cache (or (rst-all-ttls-compute) t))) (if (eq rst-all-ttls-cache t) nil - (mapcar 'rst-Ttl-copy rst-all-ttls-cache))) + (copy-sequence rst-all-ttls-cache))) (defun rst-infer-hdr-hierarchy (hdrs) + ;; testcover: ok. "Build a hierarchy from HDRS. HDRS reflects the order in which the headers appear in the buffer. Return a `rst-Hdr' list representing the hierarchy of headers in the buffer. Indentation is unified." - (let (ado2indents) + (let (ado2indents) ; Asscociates `rst-Ado' with the set of indents seen for + ; it. (dolist (hdr hdrs) (let* ((ado (rst-Hdr-ado hdr)) (indent (rst-Hdr-indent hdr)) (found (assoc ado ado2indents))) (if found - (unless (member indent (cdr found)) - ;; Append newly found indent. - (setcdr found (append (cdr found) (list indent)))) + (setcdr found (cl-adjoin indent (cdr found))) (push (list ado indent) ado2indents)))) - (mapcar (lambda (ado_indents) - (let ((ado (car ado_indents)) - (indents (cdr ado_indents))) - (rst-Hdr-new - ado - (if (> (length indents) 1) - ;; Indentations used inconsistently - use default. - rst-default-indent - ;; Only one indentation used - use this. - (car indents))))) + (mapcar (cl-function + (lambda ((ado consistent &rest inconsistent)) + (rst-Hdr-new ado (if inconsistent + rst-default-indent + consistent)))) (nreverse ado2indents)))) -(defun rst-hdr-hierarchy (&optional ignore-current) +(defun rst-hdr-hierarchy (&optional ignore-position) + ;; testcover: ok. "Return the hierarchy of section titles in the file as a `rst-Hdr' list. Each returned element may be used directly to create a section -adornment on that level. If IGNORE-CURRENT a title found on the -current line is not taken into account when building the +adornment on that level. If IGNORE-POSITION a title containing +this position is not taken into account when building the hierarchy unless it appears again elsewhere. This catches cases where the current title is edited and may not be final regarding its level. -Uses and sets `rst-hdr-hierarchy-cache' unless IGNORE-CURRENT is +Uses and sets `rst-hdr-hierarchy-cache' unless IGNORE-POSITION is given." (let* ((all-ttls (rst-all-ttls)) - (ignore-position (if ignore-current - (line-beginning-position))) (ignore-ttl (if ignore-position - (car (member-if - (lambda (ttl) - (equal ignore-position (rst-Ttl-get-title-beginning ttl))) - all-ttls)))) + (cl-find-if + #'(lambda (ttl) + (equal (rst-Ttl-contains ttl ignore-position) 0)) + all-ttls))) (really-ignore (if ignore-ttl - (<= (count-if - (lambda (ttl) - (rst-Ado-equal (rst-Ttl-ado ignore-ttl) (rst-Ttl-ado ttl))) + (<= (cl-count-if + #'(lambda (ttl) + (rst-Ado-equal (rst-Ttl-ado ignore-ttl) + (rst-Ttl-ado ttl))) all-ttls) 1))) (real-ttls (delq (if really-ignore ignore-ttl) all-ttls))) - (mapcar ;; Protect cache. - 'rst-Hdr-copy - (if (and (not ignore-current) rst-hdr-hierarchy-cache) + (copy-sequence ; Protect cache. + (if (and (not ignore-position) rst-hdr-hierarchy-cache) (if (eq rst-hdr-hierarchy-cache t) nil rst-hdr-hierarchy-cache) - (let ((r (rst-infer-hdr-hierarchy (mapcar 'rst-Ttl-hdr real-ttls)))) + (let ((r (rst-infer-hdr-hierarchy (mapcar #'rst-Ttl-hdr real-ttls)))) (setq rst-hdr-hierarchy-cache - (if ignore-current + (if ignore-position ;; Clear cache reflecting that a possible update is not ;; reflected. nil @@ -1971,48 +1902,43 @@ given." r))))) (defun rst-all-ttls-with-level () + ;; testcover: ok. "Return the section adornments with levels set according to hierarchy. -Return a list of `rst-Ttl' with ascending line number." - (let ((hier (rst-Hdr-ado-map (rst-hdr-hierarchy)))) - (mapcar - (lambda (ttl) - (rst-Ttl-set-level ttl (rst-Ado-position (rst-Ttl-ado ttl) hier)) - ttl) - (rst-all-ttls)))) +Return a list of (`rst-Ttl' . LEVEL) with ascending line number." + (let ((hier (rst-Hdr-ado-map (rst-hdr-hierarchy)))) + (mapcar + #'(lambda (ttl) + (cons ttl (rst-Ado-position (rst-Ttl-ado ttl) hier))) + (rst-all-ttls)))) (defun rst-get-previous-hdr () "Return the `rst-Hdr' before point or nil if none." - (let ((ttls (rst-all-ttls)) - (curpos (line-beginning-position)) - prev) - - ;; Search for the adornments around the current line. - (while (and ttls (< (rst-Ttl-get-title-beginning (car ttls)) curpos)) - (setq prev (car ttls) - ttls (cdr ttls))) + (let ((prev (cl-find-if #'(lambda (ttl) + (< (rst-Ttl-contains ttl (point)) 0)) + (rst-all-ttls) + :from-end t))) (and prev (rst-Ttl-hdr prev)))) (defun rst-adornment-complete-p (ado indent) - "Return true if the adornment ADO around point is complete using INDENT. + ;; testcover: ok. + "Return t if the adornment ADO around point is complete using INDENT. The adornment is complete if it is a completely correct reStructuredText adornment for the title line at point. This includes indentation and correct length of adornment lines." ;; Note: we assume that the detection of the overline as being the underline ;; of a preceding title has already been detected, and has been eliminated ;; from the adornment that is given to us. - (let ((exps (rst-re "^" (rst-Ado-char ado) - (format "\\{%d\\}" - (+ (save-excursion - ;; Determine last column of title. - (end-of-line) - (current-column)) - indent)) "$"))) - (and - (save-excursion (forward-line +1) - (looking-at exps)) - (or (rst-Ado-is-simple ado) - (save-excursion (forward-line -1) - (looking-at exps)))))) + (let ((exps (list "^" (rst-Ado-char ado) + (format "\\{%d\\}" + (+ (save-excursion + ;; Determine last column of title. + (end-of-line) + (current-column)) + indent)) "$"))) + (and (rst-forward-line-looking-at +1 exps) + (or (rst-Ado-is-simple ado) + (rst-forward-line-looking-at -1 exps)) + t))) ; Normalize return value. (defun rst-next-hdr (hdr hier prev down) ;; testcover: ok. @@ -2042,6 +1968,7 @@ HIER is nil." ;; FIXME: A line "``/`` full" is not accepted as a section title. (defun rst-adjust (pfxarg) + ;; testcover: ok. "Auto-adjust the adornment around point. Adjust/rotate the section adornment for the section title around point or promote/demote the adornments inside the region, @@ -2056,7 +1983,7 @@ to deal with all the possible cases gracefully and to do \"the right thing\" in all cases. See the documentations of `rst-adjust-section' and -`rst-promote-region' for full details. +`rst-adjust-region' for full details. The method can take either (but not both) of @@ -2067,28 +1994,18 @@ b. a negative numerical argument, which generally inverts the direction of search in the file or hierarchy. Invoke with C-- prefix for example." (interactive "P") - - (let* (;; Save our original position on the current line. - (origpt (point-marker)) - + (let* ((origpt (point-marker)) (reverse-direction (and pfxarg (< (prefix-numeric-value pfxarg) 0))) (toggle-style (and pfxarg (not reverse-direction)))) - (if (use-region-p) - ;; Adjust adornments within region. - (rst-promote-region (and pfxarg t)) - ;; Adjust adornment around point. + (rst-adjust-region (and pfxarg t)) (let ((msg (rst-adjust-section toggle-style reverse-direction))) (when msg - (apply 'message msg)))) - - ;; Run the hooks to run after adjusting. + (apply #'message msg)))) (run-hooks 'rst-adjust-hook) - (rst-reset-section-caches) - - ;; Make sure to reset the cursor position properly after we're done. - (goto-char origpt))) + (set-marker + (goto-char origpt) nil))) (defcustom rst-adjust-hook nil "Hooks to be run after running `rst-adjust'." @@ -2116,8 +2033,77 @@ Argument PFXARG has the same meaning as for `rst-adjust'." (toggle-style (and pfxarg (not reverse-direction)))) (rst-adjust-section toggle-style reverse-direction))) +(defun rst-adjust-new-hdr (toggle-style reverse ttl) + ;; testcover: ok. + "Return a new `rst-Hdr' for `rst-adjust-section' related to TTL. +TOGGLE-STYLE and REVERSE are from +`rst-adjust-section'. TOGGLE-STYLE may be consumed and thus is +returned. + +Return a list (HDR TOGGLE-STYLE MSG...). HDR is the result or +nil. TOGGLE-STYLE is the new TOGGLE-STYLE to use in the +caller. MSG is a list which is non-empty in case HDR is nil +giving an argument list for `message'." + (save-excursion + (goto-char (rst-Ttl-get-title-beginning ttl)) + (let ((indent (rst-Ttl-indent ttl)) + (ado (rst-Ttl-ado ttl)) + (prev (rst-get-previous-hdr)) + hdr-msg) + (setq + hdr-msg + (cond + ((rst-Ttl-is-candidate ttl) + ;; Case 1: No adornment at all. + (let ((hier (rst-hdr-hierarchy))) + (if prev + ;; Previous header exists - use it. + (cond + ;; Customization and parameters require that the previous level + ;; is used - use it as is. + ((or (and rst-new-adornment-down reverse) + (and (not rst-new-adornment-down) (not reverse))) + prev) + ;; Advance one level down. + ((rst-next-hdr prev hier prev t)) + ("Neither hierarchy nor preferences can suggest a deeper header")) + ;; First header in the buffer - use the first adornment from + ;; preferences or hierarchy. + (let ((p (car (rst-Hdr-preferred-adornments))) + (h (car hier))) + (cond + ((if reverse + ;; Prefer hierarchy for downwards + (or h p) + ;; Prefer preferences for upwards + (or p h))) + ("No preferences to suggest a top level from")))))) + ((not (rst-adornment-complete-p ado indent)) + ;; Case 2: Incomplete adornment. + ;; Use lax since indentation might not match suggestion. + (rst-Hdr-new-lax ado indent)) + ;; Case 3: Complete adornment exists from here on. + (toggle-style + ;; Simply switch the style of the current adornment. + (setq toggle-style nil) ; Remember toggling has been done. + (rst-Hdr-new-invert ado rst-default-indent)) + (t + ;; Rotate, ignoring a sole adornment around the current line. + (let ((hier (rst-hdr-hierarchy (point)))) + (cond + ;; Next header can be determined from hierarchy or preferences. + ((rst-next-hdr + ;; Use lax since indentation might not match suggestion. + (rst-Hdr-new-lax ado indent) hier prev reverse)) + ;; No next header found. + ("No preferences or hierarchy to suggest another level from")))))) + (if (stringp hdr-msg) + (list nil toggle-style hdr-msg) + (list hdr-msg toggle-style))))) + (defun rst-adjust-section (toggle-style reverse) -"Adjust/rotate the section adornment for the section title around point. + ;; testcover: ok. + "Adjust/rotate the section adornment for the section title around point. The action this function takes depends on context around the point, and it is meant to be invoked possibly more than once to rotate among the various possibilities. Basically, this function @@ -2191,135 +2177,71 @@ around the cursor. Then the following cases are distinguished. However, if TOGGLE-STYLE, we do not rotate the adornment, but instead simply toggle the style of the current adornment." (rst-reset-section-caches) - (let ((ttl (rst-ttl-at-point)) - (orig-pnt (point)) - msg) + (let ((ttl (rst-ttl-at-point))) (if (not ttl) - (setq msg '("No section header or candidate at point")) - (goto-char (rst-Ttl-get-title-beginning ttl)) - (let ((moved (- (line-number-at-pos) (line-number-at-pos orig-pnt))) - (found (rst-Ttl-ado ttl)) - (indent (rst-Ttl-indent ttl)) - (prev (rst-get-previous-hdr)) - new) - (when (and found (not (rst-Ado-p found))) - ;; Normalize found adornment - overline with no underline counts as - ;; overline. - (setq found (rst-Ado-new-over-and-under found))) - (setq new - (cond - ((not found) - ;; Case 1: No adornment at all. - (let ((hier (rst-hdr-hierarchy))) - (if prev - ;; Previous header exists - use it. - (cond - ;; Customization and parameters require that the - ;; previous level is used - use it as is. - ((or (and rst-new-adornment-down reverse) - (and (not rst-new-adornment-down) (not reverse))) - prev) - ;; Advance one level down. - ((rst-next-hdr prev hier prev t)) - (t - (setq msg '("Neither hierarchy nor preferences can suggest a deeper header")) - nil)) - ;; First header in the buffer - use the first adornment - ;; from preferences or hierarchy. - (let ((p (car (rst-Hdr-preferred-adornments))) - (h (car hier))) - (cond - ((if reverse - ;; Prefer hierarchy for downwards - (or h p) - ;; Prefer preferences for upwards - (or p h))) - (t - (setq msg '("No preferences to suggest a top level from")) - nil)))))) - ((not (rst-adornment-complete-p found indent)) - ;; Case 2: Incomplete adornment. - ;; Use lax since indentation might not match suggestion. - (rst-Hdr-new-lax found indent)) - ;; Case 3: Complete adornment exists from here on. - (toggle-style - ;; Simply switch the style of the current adornment. - (setq toggle-style nil) ;; Remember toggling has been done. - (rst-Hdr-new-invert found rst-default-indent)) - (t - ;; Rotate, ignoring a sole adornment around the current line. - (let ((hier (rst-hdr-hierarchy t))) - (cond - ;; Next header can be determined from hierarchy or - ;; preferences. - ((rst-next-hdr - ;; Use lax since indentation might not match suggestion. - (rst-Hdr-new-lax found indent) hier prev reverse)) - ;; No next header found. - (t - (setq msg '("No preferences or hierarchy to suggest another level from")) - nil)))))) - (if (not new) - (goto-char orig-pnt) + '("No section header or candidate at point") + (cl-destructuring-bind + (hdr toggle-style &rest msg + &aux + (indent (rst-Ttl-indent ttl)) + (moved (- (line-number-at-pos (rst-Ttl-get-title-beginning ttl)) + (line-number-at-pos)))) + (rst-adjust-new-hdr toggle-style reverse ttl) + (if msg + msg (when toggle-style - (setq new (rst-Hdr-new-invert (rst-Hdr-ado new) indent))) + (setq hdr (rst-Hdr-new-invert (rst-Hdr-ado hdr) indent))) ;; Override indent with present indent if there is some. (when (> indent 0) ;; Use lax since existing indent may not be valid for new style. - (setq new (rst-Hdr-new-lax (rst-Hdr-ado new) indent))) - (rst-update-section new) - ;; Correct the position of the cursor to more accurately reflect where - ;; it was located when the function was invoked. + (setq hdr (rst-Hdr-new-lax (rst-Hdr-ado hdr) indent))) + (goto-char (rst-Ttl-get-title-beginning ttl)) + (rst-update-section hdr) + ;; Correct the position of the cursor to more accurately reflect + ;; where it was located when the function was invoked. (unless (zerop moved) - (forward-line (- moved)) - (end-of-line))))) - msg)) + (1value ; No lines may be left to move. + (rst-forward-line-strict (- moved))) + (end-of-line)) + nil))))) ;; Maintain an alias for compatibility. (defalias 'rst-adjust-section-title 'rst-adjust) -(defun rst-promote-region (demote) +(defun rst-adjust-region (demote) + ;; testcover: ok. "Promote the section titles within the region. With argument DEMOTE or a prefix argument, demote the section titles instead. The algorithm used at the boundaries of the hierarchy is similar to that used by `rst-adjust-section'." (interactive "P") (rst-reset-section-caches) - (let ((ttls (rst-all-ttls)) - (hier (rst-hdr-hierarchy)) - (region-beg (save-excursion - (goto-char (region-beginning)) - (line-beginning-position))) - (region-end (save-excursion - (goto-char (region-end)) - (line-beginning-position))) - marker-list) - - ;; Skip the markers that come before the region beginning. - (while (and ttls (< (rst-Ttl-get-title-beginning (car ttls)) region-beg)) - (setq ttls (cdr ttls))) - - ;; Create a list of markers for all the adornments which are found within - ;; the region. + (let* ((beg (region-beginning)) + (end (region-end)) + (ttls-reg (cl-remove-if-not + #'(lambda (ttl) + (and + (>= (rst-Ttl-contains ttl beg) 0) + (< (rst-Ttl-contains ttl end) 0))) + (rst-all-ttls)))) (save-excursion - (while (and ttls (< (rst-Ttl-get-title-beginning (car ttls)) region-end)) - (push (cons (copy-marker (rst-Ttl-get-title-beginning (car ttls))) - (rst-Ttl-hdr (car ttls))) marker-list) - (setq ttls (cdr ttls))) - ;; Apply modifications. - (dolist (p marker-list) - ;; Go to the adornment to promote. - (goto-char (car p)) + (rst-destructuring-dolist + ((marker &rest hdr + &aux (hier (rst-hdr-hierarchy))) + (mapcar #'(lambda (ttl) + (cons (copy-marker (rst-Ttl-get-title-beginning ttl)) + (rst-Ttl-hdr ttl))) + ttls-reg)) + (set-marker + (goto-char marker) nil) ;; `rst-next-hdr' cannot return nil because we apply to a section ;; header so there is some hierarchy. - (rst-update-section (rst-next-hdr (cdr p) hier nil demote)) - - ;; Clear marker to avoid slowing down the editing after we're done. - (set-marker (car p) nil)) + (rst-update-section (rst-next-hdr hdr hier nil demote))) (setq deactivate-mark nil)))) (defun rst-display-hdr-hierarchy () + ;; testcover: ok. "Display the current file's section title adornments hierarchy. Hierarchy is displayed in a temporary buffer." (interactive) @@ -2333,7 +2255,7 @@ Hierarchy is displayed in a temporary buffer." (rst-update-section hdr) (goto-char (point-max)) (insert "\n") - (incf level)))))) + (cl-incf level)))))) ;; Maintain an alias for backward compatibility. (defalias 'rst-display-adornments-hierarchy 'rst-display-hdr-hierarchy) @@ -2341,6 +2263,7 @@ Hierarchy is displayed in a temporary buffer." ;; FIXME: Should accept an argument giving the hierarchy level to start with ;; instead of the top of the hierarchy. (defun rst-straighten-sections () + ;; testcover: ok. "Redo the adornments of all section titles in the current buffer. This is done using the preferred set of adornments. This can be used, for example, when using somebody else's copy of a document, @@ -2348,17 +2271,17 @@ in order to adapt it to our preferred style." (interactive) (rst-reset-section-caches) (save-excursion - (dolist (ttl-marker (mapcar - (lambda (ttl) - (cons ttl (copy-marker - (rst-Ttl-get-title-beginning ttl)))) - (rst-all-ttls-with-level))) - ;; Go to the appropriate position. - (goto-char (cdr ttl-marker)) - (rst-update-section (nth (rst-Ttl-level (car ttl-marker)) - (rst-Hdr-preferred-adornments))) - ;; Reset the marker to avoid slowing down editing. - (set-marker (cdr ttl-marker) nil)))) + (rst-destructuring-dolist + ((marker &rest level) + (mapcar + (cl-function + (lambda ((ttl &rest level)) + ;; Use markers so edits don't disturb the position. + (cons (copy-marker (rst-Ttl-get-title-beginning ttl)) level))) + (rst-all-ttls-with-level))) + (set-marker + (goto-char marker) nil) + (rst-update-section (nth level (rst-Hdr-preferred-adornments)))))) ;; Maintain an alias for compatibility. (defalias 'rst-straighten-adornments 'rst-straighten-sections) @@ -2367,9 +2290,9 @@ in order to adapt it to our preferred style." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Insert list items -; Borrowed from a2r.el (version 1.3), by Lawrence Mitchell . -; I needed to make some tiny changes to the functions, so I put it here. -; -- Wei-Wei Guo +;; Borrowed from a2r.el (version 1.3), by Lawrence Mitchell . I +;; needed to make some tiny changes to the functions, so I put it here. +;; -- Wei-Wei Guo (defconst rst-arabic-to-roman '((1000 . "M") (900 . "CM") (500 . "D") (400 . "CD") @@ -2378,73 +2301,59 @@ in order to adapt it to our preferred style." (1 . "I")) "List of maps between Arabic numbers and their Roman numeral equivalents.") -(defun rst-arabic-to-roman (num &optional arg) +(defun rst-arabic-to-roman (num) + ;; testcover: ok. "Convert Arabic number NUM to its Roman numeral representation. Obviously, NUM must be greater than zero. Don't blame me, blame the Romans, I mean \"what have the Romans ever _done_ for /us/?\" (with -apologies to Monty Python). -If optional ARG is non-nil, insert in current buffer." +apologies to Monty Python)." + (cl-check-type num (integer 1 *)) (let ((map rst-arabic-to-roman) - res) + (r "")) (while (and map (> num 0)) - (if (or (= num (caar map)) - (> num (caar map))) - (setq res (concat res (cdar map)) - num (- num (caar map))) - (setq map (cdr map)))) - (if arg (insert (or res "")) res))) - -(defun rst-roman-to-arabic (string &optional arg) + (cl-destructuring-bind ((val &rest sym) &rest next) map + (if (>= num val) + (setq r (concat r sym) + num (- num val)) + (setq map next)))) + r)) + +(defun rst-roman-to-arabic (string) + ;; testcover: ok. "Convert STRING of Roman numerals to an Arabic number. - If STRING contains a letter which isn't a valid Roman numeral, the rest of the string from that point onwards is ignored. - Hence: MMD == 2500 and -MMDFLXXVI == 2500. -If optional ARG is non-nil, insert in current buffer." +MMDFLXXVI == 2500." + (cl-check-type string string) + (cl-check-type string (satisfies (lambda (s) + (not (equal s "")))) + "Roman number may not be an empty string.") (let ((res 0) (map rst-arabic-to-roman)) - (while map - (if (string-match (concat "^" (cdar map)) string) - (setq res (+ res (caar map)) - string (replace-match "" nil t string)) - (setq map (cdr map)))) - (if arg (insert res) res))) + (save-match-data + (while map + (cl-destructuring-bind ((val &rest sym) &rest next) map + (if (string-match (concat "^" sym) string) + (setq res (+ res val) + string (replace-match "" nil t string)) + (setq map next)))) + (cl-check-type string (satisfies (lambda (s) + (equal s ""))) + "Invalid characters in roman number") + res))) ;; End of borrow. -(defun rst-find-pfx-in-region (beg end pfx-re) - "Find all the positions of prefixes in region between BEG and END. -This is used to find bullets and enumerated list items. PFX-RE is -a regular expression for matching the lines after indentation -with items. Returns a list of cons cells consisting of the point -and the column of the point." - (let ((pfx ())) - (save-excursion - (goto-char beg) - (while (< (point) end) - (back-to-indentation) - (when (and - (looking-at pfx-re) ; pfx found and... - (let ((pfx-col (current-column))) - (save-excursion - (forward-line -1) ; ...previous line is... - (back-to-indentation) - (or (looking-at (rst-re 'lin-end)) ; ...empty, - (> (current-column) pfx-col) ; ...deeper level, or - (and (= (current-column) pfx-col) - (looking-at pfx-re)))))) ; ...pfx at same level. - (push (cons (point) (current-column)) - pfx)) - (forward-line 1))) - (nreverse pfx))) - -(defun rst-insert-list-pos (newitem) - "Arrange relative position of a newly inserted list item of style NEWITEM. +;; FIXME: All the following code should not consider single lines as items but +;; paragraphs as reST does. + +(defun rst-insert-list-new-tag (tag) + ;; testcover: ok. + "Insert first item of a new list tagged with TAG. Adding a new list might consider three situations: @@ -2460,45 +2369,42 @@ When not (a), first forward point to the end of the line, and add two blank lines, then add the new list. Other situations are just ignored and left to users themselves." - (if (save-excursion - (beginning-of-line) - (looking-at (rst-re 'lin-end))) - (if (save-excursion - (forward-line -1) - (looking-at (rst-re 'lin-end))) - (insert newitem " ") - (insert "\n" newitem " ")) + ;; FIXME: Following line is not considered at all. + (let ((pfx-nls + ;; FIXME: Doesn't work properly for white-space line. See + ;; `rst-insert-list-new-BUGS'. + (if (rst-forward-line-looking-at 0 'lin-end) + (if (not (rst-forward-line-looking-at -1 'lin-end #'not)) + 0 + 1) + 2))) (end-of-line) - (insert "\n\n" newitem " "))) - -;; FIXME: Isn't this a `defconst'? -(defvar rst-initial-enums - (let (vals) - (dolist (fmt '("%s." "(%s)" "%s)")) - (dolist (c '("1" "a" "A" "I" "i")) - (push (format fmt c) vals))) - (cons "#." (nreverse vals))) - "List of initial enumerations.") - -;; FIXME: Isn't this a `defconst'? -(defvar rst-initial-items - (append (mapcar 'char-to-string rst-bullets) rst-initial-enums) + ;; FIXME: The indentation is not fixed to a single space by the syntax. May + ;; be this should be configurable or rather taken from the context. + (insert (make-string pfx-nls ?\n) tag " "))) + +(defconst rst-initial-items + (append (mapcar #'char-to-string rst-bullets) + (let (vals) + (dolist (fmt '("%s." "(%s)" "%s)")) + (dolist (c '("#" "1" "a" "A" "I" "i")) + (push (format fmt c) vals))) + (nreverse vals))) "List of initial items. It's a collection of bullets and enumerations.") (defun rst-insert-list-new-item () + ;; testcover: ok. "Insert a new list item. User is asked to select the item style first, for example (a), i), +. Use TAB for completion and choices. If user selects bullets or #, it's just added with position arranged by -`rst-insert-list-pos'. +`rst-insert-list-new-tag'. If user selects enumerations, a further prompt is given. User need to input a starting item, for example 'e' for 'A)' style. The position is -also arranged by `rst-insert-list-pos'." - (interactive) - ;; FIXME: Make this comply to `interactive' standards. +also arranged by `rst-insert-list-new-tag'." (let* ((itemstyle (completing-read "Select preferred item style [#.]: " rst-initial-items nil t nil nil "#.")) @@ -2506,7 +2412,6 @@ also arranged by `rst-insert-list-pos'." (match-string 0 itemstyle))) (no (save-match-data - ;; FIXME: Make this comply to `interactive' standards. (cond ((equal cnt "a") (let ((itemno (read-string "Give starting value [a]: " @@ -2527,66 +2432,73 @@ also arranged by `rst-insert-list-pos'." (number-to-string itemno))))))) (if no (setq itemstyle (replace-match no t t itemstyle))) - (rst-insert-list-pos itemstyle))) + (rst-insert-list-new-tag itemstyle))) (defcustom rst-preferred-bullets '(?* ?- ?+) "List of favorite bullets." :group 'rst :type `(repeat - (choice ,@(mapcar (lambda (char) - (list 'const - :tag (char-to-string char) char)) + (choice ,@(mapcar #'(lambda (char) + (list 'const + :tag (char-to-string char) char)) rst-bullets))) :package-version '(rst . "1.1.0")) (rst-testcover-defcustom) -(defun rst-insert-list-continue (curitem prefer-roman) - "Insert a list item with list start CURITEM including its indentation level. -If PREFER-ROMAN roman numbering is preferred over using letters." +(defun rst-insert-list-continue (ind tag tab prefer-roman) + ;; testcover: ok. + "Insert a new list tag after the current line according to style. +Style is defined by indentaton IND, TAG and suffix TAB. If +PREFER-ROMAN roman numbering is preferred over using letters." (end-of-line) (insert - "\n" ; FIXME: Separating lines must be possible. - (cond - ((string-match (rst-re '(:alt enmaut-tag - bul-tag)) curitem) - curitem) - ((string-match (rst-re 'num-tag) curitem) - (replace-match (number-to-string - (1+ (string-to-number (match-string 0 curitem)))) - nil nil curitem)) - ((and (string-match (rst-re 'rom-tag) curitem) - (save-match-data - (if (string-match (rst-re 'ltr-tag) curitem) ; Also a letter tag. - (save-excursion - ;; FIXME: Assumes one line list items without separating - ;; empty lines. - (if (and (zerop (forward-line -1)) - (looking-at (rst-re 'enmexp-beg))) - (string-match - (rst-re 'rom-tag) - (match-string 0)) ; Previous was a roman tag. - prefer-roman)) ; Don't know - use flag. - t))) ; Not a letter tag. - (replace-match - (let* ((old (match-string 0 curitem)) - (new (save-match-data - (rst-arabic-to-roman - (1+ (rst-roman-to-arabic - (upcase old))))))) - (if (equal old (upcase old)) - (upcase new) - (downcase new))) - t nil curitem)) - ((string-match (rst-re 'ltr-tag) curitem) - (replace-match (char-to-string - (1+ (string-to-char (match-string 0 curitem)))) - nil nil curitem))))) + ;; FIXME: Separating lines must be possible. + "\n" + ind + (save-match-data + (if (not (string-match (rst-re 'cntexp-tag) tag)) + tag + (let ((pfx (substring tag 0 (match-beginning 0))) + (cnt (match-string 0 tag)) + (sfx (substring tag (match-end 0)))) + (concat + pfx + (cond + ((string-match (rst-re 'num-tag) cnt) + (number-to-string (1+ (string-to-number (match-string 0 cnt))))) + ((and + (string-match (rst-re 'rom-tag) cnt) + (save-match-data + (if (string-match (rst-re 'ltr-tag) cnt) ; Also a letter tag. + (save-excursion + ;; FIXME: Assumes one line list items without separating + ;; empty lines. + ;; Use of `rst-forward-line-looking-at' is very difficult + ;; here so don't do it. + (if (and (rst-forward-line-strict -1) + (looking-at (rst-re 'enmexp-beg))) + (string-match + (rst-re 'rom-tag) + (match-string 0)) ; Previous was a roman tag. + prefer-roman)) ; Don't know - use flag. + t))) ; Not a letter tag. + (let* ((old (match-string 0 cnt)) + (new (rst-arabic-to-roman + (1+ (rst-roman-to-arabic (upcase old)))))) + (if (equal old (upcase old)) + (upcase new) + (downcase new)))) + ((string-match (rst-re 'ltr-tag) cnt) + (char-to-string (1+ (string-to-char (match-string 0 cnt)))))) + sfx)))) + tab)) ;; FIXME: At least the continuation may be folded into ;; `newline-and-indent`. However, this may not be wanted by everyone so ;; it should be possible to switch this off. (defun rst-insert-list (&optional prefer-roman) + ;; testcover: ok. "Insert a list item at the current point. The command can insert a new list or a continuing list. When it is called at a @@ -2614,84 +2526,135 @@ preceded by a blank line, it is hard to determine which type to use automatically. The function uses alphabetical list by default. If you want roman numerical list, just use a prefix to set PREFER-ROMAN." (interactive "P") - (beginning-of-line) - (if (looking-at (rst-re 'itmany-beg-1)) - (rst-insert-list-continue (match-string 0) prefer-roman) - (rst-insert-list-new-item))) + (save-match-data + (1value + (rst-forward-line-strict 0)) + ;; FIXME: Finds only tags in single line items. Multi-line items should be + ;; considered as well. + ;; Using `rst-forward-line-looking-at' is more complicated so don't do it. + (if (looking-at (rst-re 'itmany-beg-1)) + (rst-insert-list-continue + (buffer-substring-no-properties + (match-beginning 0) (match-beginning 1)) + (match-string 1) + (buffer-substring-no-properties (match-end 1) (match-end 0)) + prefer-roman) + (rst-insert-list-new-item)))) + +;; FIXME: This is wrong because it misses prefixed lines without intervening +;; new line. See `rst-straighten-bullets-region-BUGS' and +;; `rst-find-begs-BUGS'. +(defun rst-find-begs (beg end rst-re-beg) + ;; testcover: ok. + "Return the positions of begs in region BEG to END. +RST-RE-BEG is a `rst-re' argument and matched at the beginning of +a line. Return a list of (POINT . COLUMN) where POINT gives the +point after indentaton and COLUMN gives its column. The list is +ordererd by POINT." + (let (r) + (save-match-data + (save-excursion + ;; FIXME refactoring: Consider making this construct a macro looping + ;; over the lines. + (goto-char beg) + (1value + (rst-forward-line-strict 0)) + (while (< (point) end) + (let ((clm (current-indentation))) + ;; FIXME refactoring: Consider using `rst-forward-line-looking-at'. + (when (and + (looking-at (rst-re rst-re-beg)) ; Start found + (not (rst-forward-line-looking-at + -1 'lin-end + #'(lambda (mtcd) ; Previous line exists and is... + (and + (not mtcd) ; non-empty, + (<= (current-indentation) clm) ; less indented + (not (and (= (current-indentation) clm) + ; not a beg at same level. + (looking-at (rst-re rst-re-beg))))))))) + (back-to-indentation) + (push (cons (point) clm) r))) + (1value ; At least one line is moved in this loop. + (rst-forward-line-strict 1 end))))) + (nreverse r))) (defun rst-straighten-bullets-region (beg end) - "Make all the bulleted list items in the region consistent. -The region is specified between BEG and END. You can use this -after you have merged multiple bulleted lists to make them use -the same/correct/consistent bullet characters. - -See variable `rst-preferred-bullets' for the list of bullets to -adjust. If bullets are found on levels beyond the -`rst-preferred-bullets' list, they are not modified." + ;; testcover: ok. + "Make all the bulleted list items in the region from BEG to END consistent. +Use this after you have merged multiple bulleted lists to make +them use the preferred bullet characters given by +`rst-preferred-bullets' for each level. If bullets are found on +levels beyond the `rst-preferred-bullets' list, they are not +modified." (interactive "r") - - (let ((bullets (rst-find-pfx-in-region beg end (rst-re 'bul-sta))) - (levtable (make-hash-table :size 4))) - - ;; Create a map of levels to list of positions. - (dolist (x bullets) - (let ((key (cdr x))) - (puthash key - (append (gethash key levtable (list)) - (list (car x))) - levtable))) - - ;; Sort this map and create a new map of prefix char and list of positions. - (let ((poslist ())) ; List of (indent . positions). - (maphash (lambda (x y) (push (cons x y) poslist)) levtable) - - (let ((bullets rst-preferred-bullets)) - (dolist (x (sort poslist 'car-less-than-car)) - (when bullets - ;; Apply the characters. - (dolist (pos (cdr x)) - (goto-char pos) - (delete-char 1) - (insert (string (car bullets)))) - (setq bullets (cdr bullets)))))))) + (save-excursion + (let (clm2pnts) ; Map a column to a list of points at this column. + (rst-destructuring-dolist + ((point &rest column + &aux (found (assoc column clm2pnts))) + (rst-find-begs beg end 'bul-beg)) + (if found + ;;; (push point (cdr found)) ; FIXME: Doesn't work with `testcover'. + (setcdr found (cons point (cdr found))) ; Synonym. + (push (list column point) clm2pnts))) + (rst-destructuring-dolist + ((bullet _clm &rest pnts) + ;; Zip preferred bullets and sorted columns associating a bullet + ;; with a column and all the points this column is found. + (cl-mapcar #'(lambda (bullet clm2pnt) + (cons bullet clm2pnt)) + rst-preferred-bullets + (sort clm2pnts #'car-less-than-car))) + ;; Replace the bullets by the preferred ones. + (dolist (pnt pnts) + (goto-char pnt) + ;; FIXME: Assumes bullet to replace is a single char. + (delete-char 1) + (insert bullet)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Table of contents (defun rst-all-stn () - "Return the hierarchical tree of section titles as a top level `rst-Stn'. -Return nil for no section titles." - ;; FIXME: The top level node may contain the document title instead of nil. + ;; testcover: ok. + "Return the hierarchical tree of sections as a top level `rst-Stn'. +Return value satisfies `rst-Stn-is-top' or is nil for no +sections." (cdr (rst-remaining-stn (rst-all-ttls-with-level) -1))) -(defun rst-remaining-stn (remaining lev) - "Process the first entry of REMAINING expected to be on level LEV. -REMAINING is the remaining list of `rst-Ttl' entries. -Return (UNPROCESSED . NODE) for the first entry of REMAINING. -UNPROCESSED is the list of still unprocessed entries. NODE is a -`rst-Stn' or nil if REMAINING is empty." - (let ((ttl (car remaining)) - (unprocessed remaining) - fnd children) - ;; If the current adornment matches expected level. - (when (and ttl (= (rst-Ttl-level ttl) lev)) - ;; Consume the current entry and create the current node with it. - (setq unprocessed (cdr remaining)) - (setq fnd ttl)) - ;; Build the child nodes as long as they have deeper level. - (while (and unprocessed (> (rst-Ttl-level (car unprocessed)) lev)) - (let* ((rem-child (rst-remaining-stn unprocessed (1+ lev))) - (child (cdr rem-child))) - (when child - (push child children)) - (setq unprocessed (car rem-child)))) - (setq children (reverse children)) - (cons unprocessed - (if (or fnd children) - (rst-Stn-new fnd lev children))))) +(defun rst-remaining-stn (unprocessed expected) + ;; testcover: ok. + "Process the first entry of UNPROCESSED expected to be on level EXPECTED. +UNPROCESSED is the remaining list of (`rst-Ttl' . LEVEL) entries. +Return (REMAINING . STN) for the first entry of UNPROCESSED. +REMAINING is the list of still unprocessed entries. STN is a +`rst-Stn' or nil if UNPROCESSED is empty." + (if (not unprocessed) + (1value + (cons nil nil)) + (cl-destructuring-bind + ((ttl &rest level) &rest next + &aux fnd children) + unprocessed + (when (= level expected) + ;; Consume the current entry and create the current node with it. + (setq fnd ttl) + (setq unprocessed next)) + ;; Build the child nodes as long as they have deeper level. + (while (and unprocessed (> (cdar unprocessed) expected)) + (cl-destructuring-bind (remaining &rest stn) + (rst-remaining-stn unprocessed (1+ expected)) + (when stn + (push stn children)) + (setq unprocessed remaining))) + (cons unprocessed + (when (or fnd children) + (rst-Stn-new fnd expected (nreverse children))))))) (defun rst-stn-containing-point (stn &optional point) + ;; testcover: ok. "Return `rst-Stn' in STN before POINT or nil if in no section. POINT defaults to the current point. STN may be nil for no section headers at all." @@ -2699,15 +2662,13 @@ section headers at all." (setq point (or point (point))) (when (>= point (rst-Stn-get-title-beginning stn)) ;; Point may be in this section or a child. - (let ((children (rst-Stn-children stn)) - found) - (while (and children - (>= point (rst-Stn-get-title-beginning (car children)))) - ;; Point may be in this child. - (setq found (car children) - children (cdr children))) - (if found - (rst-stn-containing-point found point) + (let ((in-child (cl-find-if + #'(lambda (child) + (>= point (rst-Stn-get-title-beginning child))) + (rst-Stn-children stn) + :from-end t))) + (if in-child + (rst-stn-containing-point in-child point) stn))))) (defgroup rst-toc nil @@ -2729,7 +2690,7 @@ indentation style: - `plain': no numbering (fixed indentation) - `fixed': numbering, but fixed indentation - `aligned': numbering, titles aligned under each other -- `listed': numbering, with dashes like list items (EXPERIMENTAL)" +- `listed': titles as list items" :type '(choice (const plain) (const fixed) (const aligned) @@ -2743,143 +2704,204 @@ indentation style: :group 'rst-toc) (rst-testcover-defcustom) -;; FIXME: What does this mean? -;; This is used to avoid having to change the user's mode. -(defvar rst-toc-insert-click-keymap - (let ((map (make-sparse-keymap))) - (define-key map [mouse-1] 'rst-toc-mode-mouse-goto) - map) - "(Internal) What happens when you click on propertized text in the TOC.") - (defcustom rst-toc-insert-max-level nil "If non-nil, maximum depth of the inserted TOC." :type '(choice (const nil) integer) :group 'rst-toc) (rst-testcover-defcustom) -(defun rst-toc-insert (&optional pfxarg) - "Insert a text rendering of the table of contents of the current section. +(defun rst-toc-insert (&optional max-level) + ;; testcover: ok. + "Insert the table of contents of the current section at the current column. By default the top level is ignored if there is only one, because -we assume that the document will have a single title. - -If a numeric prefix argument PFXARG is given, insert the TOC up -to the specified level. - -The TOC is inserted indented at the current column." +we assume that the document will have a single title. A numeric +prefix argument MAX-LEVEL overrides `rst-toc-insert-max-level'. +Text in the line beyond column is deleted." (interactive "P") (rst-reset-section-caches) - (let (;; Check maximum level override. - (rst-toc-insert-max-level - (if (and (integerp pfxarg) (> (prefix-numeric-value pfxarg) 0)) - (prefix-numeric-value pfxarg) rst-toc-insert-max-level)) - (pt-stn (rst-stn-containing-point (rst-all-stn))) - ;; Figure out initial indent. - (initial-indent (make-string (current-column) ? )) - (init-point (point))) - (when (and pt-stn (rst-Stn-children pt-stn)) - (rst-toc-insert-node pt-stn 0 initial-indent "") - ;; FIXME: Really having the last newline would be better. - ;; Delete the last newline added. - (delete-char -1)))) - -(defun rst-toc-insert-node (stn level indent pfx) - "Insert STN in table-of-contents. -LEVEL is the depth level of the sections in the tree currently -rendered. INDENT is the indentation string. PFX is the prefix -numbering, that includes the alignment necessary for all the -children of level to align." - ;; Note: we do child numbering from the parent, so we start number the - ;; children one level before we print them. - (when (> level 0) - (unless (> (current-column) 0) - ;; No indent yet - insert it. - (insert indent)) - (let ((beg (point))) - (unless (equal rst-toc-insert-style 'plain) - (insert pfx rst-toc-insert-number-separator)) - (insert (rst-Stn-get-text stn)) - ;; Add properties to the text, even though in normal text mode it - ;; won't be doing anything for now. Not sure that I want to change - ;; mode stuff. At least the highlighting gives the idea that this - ;; is generated automatically. - (put-text-property beg (point) 'mouse-face 'highlight) - (put-text-property - beg (point) 'rst-toc-target - (set-marker (make-marker) (rst-Stn-get-title-beginning stn))) - (put-text-property beg (point) 'keymap rst-toc-insert-click-keymap)) + (let ((pt-stn (rst-stn-containing-point (rst-all-stn)))) + (when pt-stn + (let ((max + (if (and (integerp max-level) + (> (prefix-numeric-value max-level) 0)) + (prefix-numeric-value max-level) + rst-toc-insert-max-level)) + (ind (current-column)) + (buf (current-buffer)) + (tabs indent-tabs-mode) ; Copy buffer local value. + txt) + (setq txt + ;; Render to temporary buffer so markers are created correctly. + (with-temp-buffer + (rst-toc-insert-tree pt-stn buf rst-toc-insert-style max + rst-toc-link-keymap nil) + (goto-char (point-min)) + (when (rst-forward-line-strict 1) + ;; There are lines to indent. + (let ((indent-tabs-mode tabs)) + (indent-rigidly (point) (point-max) ind))) + (buffer-string))) + (unless (zerop (length txt)) + ;; Delete possible trailing text. + (delete-region (point) (line-beginning-position 2)) + (insert txt) + (backward-char 1)))))) + +(defun rst-toc-insert-link (pfx stn buf keymap) + ;; testcover: ok. + "Insert text of STN in BUF as a linked section reference at point. +If KEYMAP use this as keymap property. PFX is inserted before text." + (let ((beg (point))) + (insert pfx) + (insert (rst-Stn-get-text stn)) + (put-text-property beg (point) 'mouse-face 'highlight) (insert "\n") - ;; Prepare indent for children. - (setq indent - (cond - ((eq rst-toc-insert-style 'plain) - (concat indent (make-string rst-toc-indent ? ))) - ((eq rst-toc-insert-style 'fixed) - (concat indent (make-string rst-toc-indent ? ))) - ((eq rst-toc-insert-style 'aligned) - (concat indent (make-string (+ (length pfx) 2) ? ))) - ((eq rst-toc-insert-style 'listed) - (concat (substring indent 0 -3) - (concat (make-string (+ (length pfx) 2) ? ) " - ")))))) - (when (or (eq rst-toc-insert-max-level nil) - (< level rst-toc-insert-max-level)) - (let ((count 1) - fmt) - ;; Add a separating dot if there is already a prefix. - (when (> (length pfx) 0) - (string-match (rst-re "[ \t\n]*\\'") pfx) - (setq pfx (concat (replace-match "" t t pfx) "."))) - ;; Calculate the amount of space that the prefix will require - ;; for the numbers. - (when (rst-Stn-children stn) - (setq fmt - (format "%%-%dd" - (1+ (floor (log (length (rst-Stn-children stn)) - 10)))))) - (dolist (child (rst-Stn-children stn)) - (rst-toc-insert-node child (1+ level) indent - (concat pfx (format fmt count))) - (incf count))))) + (put-text-property + beg (point) 'rst-toc-target + (set-marker (make-marker) (rst-Stn-get-title-beginning stn) buf)) + (when keymap + (put-text-property beg (point) 'keymap keymap)))) + +(defun rst-toc-get-link (link-buf link-pnt) + ;; testcover: ok. + "Return the link from text property at LINK-PNT in LINK-BUF." + (let ((mrkr (get-text-property link-pnt 'rst-toc-target link-buf))) + (unless mrkr + (error "No section on this line")) + (unless (buffer-live-p (marker-buffer mrkr)) + (error "Buffer for this section was killed")) + mrkr)) + +(defconst rst-toc-link-keymap + (let ((map (make-sparse-keymap))) + (define-key map [mouse-1] 'rst-toc-mouse-follow-link) + map) + "Keymap used for links in TOC.") + +(defun rst-toc-insert-tree (stn buf style depth keymap tgt-stn) + ;; testcover: ok. + "Insert table of contents of tree below top node STN in buffer BUF. +STYLE is the style to use and must be one of the symbols allowed +for `rst-toc-insert-style'. DEPTH is the maximum relative depth +from STN to insert or nil for no maximum depth. See +`rst-toc-insert-link' for KEYMAP. Return beginning of title line +if TGT-STN is rendered or nil if not rendered or TGT-STN is nil. +Just return nil if STN is nil." + (when stn + (rst-toc-insert-children (rst-Stn-children stn) buf style depth 0 "" keymap + tgt-stn))) + +(defun rst-toc-insert-children (children buf style depth indent numbering + keymap tgt-stn) + ;; testcover: ok. + "In the current buffer at point insert CHILDREN in BUF to table of contents. +See `rst-toc-insert-tree' for STYLE, DEPTH and TGT-STN. See +`rst-toc-insert-stn' for INDENT and NUMBERING. See +`rst-toc-insert-link' for KEYMAP." + (let ((count 1) + ;; Child numbering is done from the parent. + (num-fmt (format "%%%dd" + (1+ (floor (log (1+ (length children)) 10))))) + fnd) + (when (not (equal numbering "")) + ;; Add separating dot to existing numbering. + (setq numbering (concat numbering "."))) + (dolist (child children fnd) + (setq fnd + (or (rst-toc-insert-stn child buf style depth indent + (concat numbering (format num-fmt count)) + keymap tgt-stn) fnd)) + (cl-incf count)))) + +;; FIXME refactoring: Use `rst-Stn-buffer' instead of `buf'. +(defun rst-toc-insert-stn (stn buf style depth indent numbering keymap tgt-stn) + ;; testcover: ok. + "In the current buffer at point insert STN in BUF into table of contents. +See `rst-toc-insert-tree' for STYLE, DEPTH and TGT-STN. INDENT +is the indentation depth to use for STN. NUMBERING is the prefix +numbering for STN. See `rst-toc-insert-link' for KEYMAP." + (when (or (not depth) (> depth 0)) + (cl-destructuring-bind + (pfx add + &aux (fnd (when (and tgt-stn + (equal (rst-Stn-get-title-beginning stn) + (rst-Stn-get-title-beginning tgt-stn))) + (point)))) + (cond + ((eq style 'plain) + (list "" rst-toc-indent)) + ((eq style 'fixed) + (list (concat numbering rst-toc-insert-number-separator) + rst-toc-indent)) + ((eq style 'aligned) + (list (concat numbering rst-toc-insert-number-separator) + (+ (length numbering) + (length rst-toc-insert-number-separator)))) + ((eq style 'listed) + (list (format "%c " (car rst-preferred-bullets)) 2))) + ;; Indent using spaces so buffer characteristics like `indent-tabs-mode' + ;; do not matter. + (rst-toc-insert-link (concat (make-string indent ? ) pfx) stn buf keymap) + (or (rst-toc-insert-children (rst-Stn-children stn) buf style + (when depth + (1- depth)) + (+ indent add) numbering keymap tgt-stn) + fnd)))) (defun rst-toc-update () + ;; testcover: ok. "Automatically find the contents section of a document and update. Updates the inserted TOC if present. You can use this in your file-write hook to always make it up-to-date automatically." (interactive) - (save-excursion - ;; Find and delete an existing comment after the first contents directive. - ;; Delete that region. - (goto-char (point-min)) - ;; We look for the following and the following only (in other words, if your - ;; syntax differs, this won't work.). - ;; - ;; .. contents:: [...anything here...] - ;; [:field: value]... - ;; .. - ;; XXXXXXXX - ;; XXXXXXXX - ;; [more lines] - (let ((beg (re-search-forward - (rst-re "^" 'exm-sta "contents" 'dcl-tag ".*\n" - "\\(?:" 'hws-sta 'fld-tag ".*\n\\)*" 'exm-tag) nil t)) - last-real) - (when beg - ;; Look for the first line that starts at the first column. - (forward-line 1) - (while (and - (< (point) (point-max)) - (or (if (looking-at - (rst-re 'hws-sta "\\S ")) ; indented content. - (setq last-real (point))) - (looking-at (rst-re 'lin-end)))) ; empty line. - (forward-line 1)) - (if last-real - (progn - (goto-char last-real) - (end-of-line) - (delete-region beg (point))) - (goto-char beg)) - (insert "\n ") - (rst-toc-insert)))) + (save-match-data + (save-excursion + ;; Find and delete an existing comment after the first contents + ;; directive. Delete that region. + (goto-char (point-min)) + ;; FIXME: Should accept indentation of the whole block. + ;; We look for the following and the following only (in other words, if + ;; your syntax differs, this won't work.). + ;; + ;; .. contents:: [...anything here...] + ;; [:field: value]... + ;; .. + ;; XXXXXXXX + ;; XXXXXXXX + ;; [more lines] + ;; FIXME: Works only for the first of these tocs. There should be a + ;; fixed text after the comment such as "RST-MODE ELECTRIC TOC". + ;; May be parameters such as `max-level' should be appended. + (let ((beg (re-search-forward + (1value + (rst-re "^" 'exm-sta "contents" 'dcl-tag ".*\n" + "\\(?:" 'hws-sta 'fld-tag ".*\n\\)*" 'exm-tag)) + nil t)) + fnd) + (when + (and beg + (rst-forward-line-looking-at + 1 'lin-end + #'(lambda (mtcd) + (unless mtcd + (rst-apply-indented-blocks + (point) (point-max) (current-indentation) + #'(lambda (count _in-first _in-sub in-super in-empty + _relind) + (cond + ((or (> count 1) in-super)) + ((not in-empty) + (setq fnd (line-end-position)) + nil))))) + t))) + (when fnd + (delete-region beg fnd)) + (goto-char beg) + (insert "\n ") + ;; FIXME: Ignores an `max-level' given to the original + ;; `rst-toc-insert'. `max-level' could be rendered to the first + ;; line. + (rst-toc-insert))))) ;; Note: always return nil, because this may be used as a hook. nil) @@ -2891,58 +2913,26 @@ file-write hook to always make it up-to-date automatically." ;; ;; Disable undo for the write file hook. ;; (let ((buffer-undo-list t)) (rst-toc-update) )) -(defalias 'rst-toc-insert-update 'rst-toc-update) ; backwards compat. +;; Maintain an alias for compatibility. +(defalias 'rst-toc-insert-update 'rst-toc-update) -(defun rst-toc-node (stn buf target) - "Insert STN in the table-of-contents of buffer BUF. -If TARGET is given and this call renders a `rst-Stn' at the same -location return position of beginning of line. Otherwise return -nil." - (let ((beg (point)) - fnd) - (if (or (not stn) (rst-Stn-is-top stn)) - (progn - (insert (format "Table of Contents:\n")) - (put-text-property beg (point) - 'face (list '(background-color . "gray")))) - (when (and target - (equal (rst-Stn-get-title-beginning stn) - (rst-Stn-get-title-beginning target))) - (setq fnd beg)) - (insert (make-string (* rst-toc-indent (rst-Stn-level stn)) ? )) - (insert (rst-Stn-get-text stn)) - ;; Highlight lines. - (put-text-property beg (point) 'mouse-face 'highlight) - (insert "\n") - ;; Add link on lines. - (put-text-property - beg (point) 'rst-toc-target - (set-marker (make-marker) (rst-Stn-get-title-beginning stn) buf))) - (when stn - (dolist (child (rst-Stn-children stn)) - (setq fnd (or (rst-toc-node child buf target) fnd)))) - fnd)) - -(defvar rst-toc-buffer-name "*Table of Contents*" +(defconst rst-toc-buffer-name "*Table of Contents*" "Name of the Table of Contents buffer.") -(defvar rst-toc-return-wincfg nil +(defvar-local rst-toc-mode-return-wincfg nil "Window configuration to which to return when leaving the TOC.") (defun rst-toc () - "Display a table-of-contents. -Finds all the section titles and their adornments in the -file, and displays a hierarchically-organized list of the -titles, which is essentially a table-of-contents of the -document. - -The Emacs buffer can be navigated, and selecting a section -brings the cursor in that section." + ;; testcover: ok. + "Display a table of contents for current buffer. +Displays all section titles found in the current buffer in a +hierarchical list. The resulting buffer can be navigated, and +selecting a section title moves the cursor to that section." (interactive) (rst-reset-section-caches) (let* ((wincfg (list (current-window-configuration) (point-marker))) (sectree (rst-all-stn)) - (target-node (rst-stn-containing-point sectree)) + (target-stn (rst-stn-containing-point sectree)) (target-buf (current-buffer)) (buf (get-buffer-create rst-toc-buffer-name)) target-pos) @@ -2950,134 +2940,174 @@ brings the cursor in that section." (let ((inhibit-read-only t)) (rst-toc-mode) (delete-region (point-min) (point-max)) - (setq target-pos (rst-toc-node sectree target-buf target-node)))) + ;; FIXME: Could use a customizable style. + (setq target-pos (rst-toc-insert-tree + sectree target-buf 'plain nil nil target-stn)))) (display-buffer buf) (pop-to-buffer buf) - (setq-local rst-toc-return-wincfg wincfg) + (setq rst-toc-mode-return-wincfg wincfg) (goto-char (or target-pos (point-min))))) -(defun rst-toc-mode-find-section () - "Get the section from text property at point." - (let ((pos (get-text-property (point) 'rst-toc-target))) - (unless pos - (error "No section on this line")) - (unless (buffer-live-p (marker-buffer pos)) - (error "Buffer for this section was killed")) - pos)) +;; Maintain an alias for compatibility. +(defalias 'rst-goto-section 'rst-toc-follow-link) + +(defun rst-toc-follow-link (link-buf link-pnt kill) + ;; testcover: ok. + "Follow the link to the section at LINK-PNT in LINK-BUF. +LINK-PNT and LINK-BUF default to the point in the current buffer. +With prefix argument KILL a TOC buffer is destroyed. Throw an +error if there is no working link at the given position." + (interactive "i\nd\nP") + (unless link-buf + (setq link-buf (current-buffer))) + ;; Do not catch errors from `rst-toc-get-link' because otherwise the error is + ;; suppressed and invisible in interactve use. + (let ((mrkr (rst-toc-get-link link-buf link-pnt))) + (condition-case nil + (rst-toc-mode-return kill) + ;; Catch errors when not in `toc-mode'. + (error nil)) + (pop-to-buffer (marker-buffer mrkr)) + (goto-char mrkr) + ;; FIXME: Should be a customizable number of lines from beginning or end of + ;; window just like the argument to `recenter`. It would be ideal if + ;; the adornment is always completely visible. + (recenter 5))) + +;; Maintain an alias for compatibility. +(defalias 'rst-toc-mode-goto-section 'rst-toc-mode-follow-link-kill) ;; FIXME: Cursor before or behind the list must be handled properly; before the ;; list should jump to the top and behind the list to the last normal ;; paragraph. -(defun rst-goto-section (&optional kill) - "Go to the section the current line describes. -If KILL a TOC buffer is destroyed." +(defun rst-toc-mode-follow-link-kill () + ;; testcover: ok. + "Follow the link to the section at point and kill the TOC buffer." (interactive) - (let ((pos (rst-toc-mode-find-section))) - (when kill - ;; FIXME: This should rather go to `rst-toc-mode-goto-section'. - (set-window-configuration (car rst-toc-return-wincfg)) - (kill-buffer (get-buffer rst-toc-buffer-name))) - (pop-to-buffer (marker-buffer pos)) - (goto-char pos) - ;; FIXME: make the recentering conditional on scroll. - (recenter 5))) + (rst-toc-follow-link (current-buffer) (point) t)) -(defun rst-toc-mode-goto-section () - "Go to the section the current line describes and kill the TOC buffer." - (interactive) - (rst-goto-section t)) +;; Maintain an alias for compatibility. +(defalias 'rst-toc-mode-mouse-goto 'rst-toc-mouse-follow-link) -(defun rst-toc-mode-mouse-goto (event) +(defun rst-toc-mouse-follow-link (event kill) + ;; testcover: uncovered. "In `rst-toc' mode, go to the occurrence whose line you click on. -EVENT is the input event." - (interactive "e") - (let ((pos - (with-current-buffer (window-buffer (posn-window (event-end event))) - (save-excursion - (goto-char (posn-point (event-end event))) - (rst-toc-mode-find-section))))) - (pop-to-buffer (marker-buffer pos)) - (goto-char pos) - (recenter 5))) +EVENT is the input event. Kill TOC buffer if KILL." + (interactive "e\ni") + (rst-toc-follow-link (window-buffer (posn-window (event-end event))) + (posn-point (event-end event)) kill)) + +;; Maintain an alias for compatibility. +(defalias 'rst-toc-mode-mouse-goto-kill 'rst-toc-mode-mouse-follow-link-kill) -(defun rst-toc-mode-mouse-goto-kill (event) - "Same as `rst-toc-mode-mouse-goto', but kill TOC buffer as well. +(defun rst-toc-mode-mouse-follow-link-kill (event) + ;; testcover: uncovered. + "Same as `rst-toc-mouse-follow-link', but kill TOC buffer as well. EVENT is the input event." (interactive "e") - (call-interactively 'rst-toc-mode-mouse-goto event) - (kill-buffer (get-buffer rst-toc-buffer-name))) + (rst-toc-mouse-follow-link event t)) + +;; Maintain an alias for compatibility. +(defalias 'rst-toc-quit-window 'rst-toc-mode-return) + +(defun rst-toc-mode-return (kill) + ;; testcover: ok. + "Leave the current TOC buffer and return to the previous environment. +With prefix argument KILL non-nil, kill the buffer instead of +burying it." + (interactive "P") + (unless rst-toc-mode-return-wincfg + (error "Not in a `toc-mode' buffer")) + (cl-destructuring-bind + (wincfg pos + &aux (toc-buf (current-buffer))) + rst-toc-mode-return-wincfg + (set-window-configuration wincfg) + (goto-char pos) + (if kill + (kill-buffer toc-buf) + (bury-buffer toc-buf)))) -(defun rst-toc-quit-window () - "Leave the current TOC buffer." +(defun rst-toc-mode-return-kill () + ;; testcover: uncovered. + "Like `rst-toc-mode-return' but kill TOC buffer." (interactive) - (let ((retbuf rst-toc-return-wincfg)) - (set-window-configuration (car retbuf)) - (goto-char (cadr retbuf)))) + (rst-toc-mode-return t)) (defvar rst-toc-mode-map (let ((map (make-sparse-keymap))) - (define-key map [mouse-1] 'rst-toc-mode-mouse-goto-kill) - ;; FIXME: This very useful function must be on some key. - (define-key map [mouse-2] 'rst-toc-mode-mouse-goto) - (define-key map "\C-m" 'rst-toc-mode-goto-section) - (define-key map "f" 'rst-toc-mode-goto-section) - (define-key map "q" 'rst-toc-quit-window) - ;; FIXME: Killing should clean up like `rst-toc-quit-window' does. - (define-key map "z" 'kill-this-buffer) + (define-key map [mouse-1] #'rst-toc-mode-mouse-follow-link-kill) + (define-key map [mouse-2] #'rst-toc-mouse-follow-link) + (define-key map "\C-m" #'rst-toc-mode-follow-link-kill) + (define-key map "f" #'rst-toc-mode-follow-link-kill) + (define-key map "n" #'next-line) + (define-key map "p" #'previous-line) + (define-key map "q" #'rst-toc-mode-return) + (define-key map "z" #'rst-toc-mode-return-kill) map) "Keymap for `rst-toc-mode'.") -(put 'rst-toc-mode 'mode-class 'special) - -;; Could inherit from the new `special-mode'. -(define-derived-mode rst-toc-mode nil "ReST-TOC" +(define-derived-mode rst-toc-mode special-mode "ReST-TOC" "Major mode for output from \\[rst-toc], the table-of-contents for the document. - \\{rst-toc-mode-map}" - (setq buffer-read-only t)) + ;; FIXME: `revert-buffer-function` must be defined so `revert-buffer` works + ;; as expected for a special mode. In particular the referred buffer + ;; needs to be rescanned and the TOC must be updated accordingly. + ;; FIXME: Should contain the name of the buffer this is the toc of. + (setq header-line-format "Table of Contents")) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Section movement -(defun rst-forward-section (&optional offset) - "Skip to the next reStructuredText section title. -OFFSET specifies how many titles to skip. Use a negative OFFSET -to move backwards in the file (default is to use 1)." - (interactive) +;; FIXME testcover: Use `testcover'. Mark up a function with sufficient test +;; coverage by a comment tagged with `testcover' after the +;; `defun'. Then move this comment. + +(defun rst-forward-section (offset) + "Jump forward OFFSET section titles ending up at the start of the title line. +OFFSET defaults to 1 and may be negative to move backward. An +OFFSET of 0 does not move unless point is inside a title. Go to +end or beginning of buffer if no more section titles in the desired +direction." + (interactive "p") (rst-reset-section-caches) - (let* ((offset (or offset 1)) - (ttls (rst-all-ttls)) - (curpos (line-beginning-position)) - (cur ttls) - (idx 0) - ttl) - - ;; Find the index of the "next" adornment with respect to the current line. - (while (and cur (< (rst-Ttl-get-title-beginning (car cur)) curpos)) - (setq cur (cdr cur)) - (incf idx)) - ;; `cur' is the `rst-Ttl' on or following the current line. - - (if (and (> offset 0) cur - (equal (rst-Ttl-get-title-beginning (car cur)) curpos)) - (incf idx)) - - ;; Find the final index. - (setq idx (+ idx (if (> offset 0) (- offset 1) offset))) - (setq ttl (nth idx ttls)) + (let* ((ttls (rst-all-ttls)) + (count (length ttls)) + (pnt (point)) + (contained nil) ; Title contains point (or is after point otherwise). + (found (or (cl-position-if + ;; Find a title containing or after point. + #'(lambda (ttl) + (let ((cmp (rst-Ttl-contains ttl pnt))) + (cond + ((= cmp 0) ; Title contains point. + (setq contained t) + t) + ((> cmp 0) ; Title after point. + t)))) + ttls) + ;; Point after all titles. + count)) + (target (+ found offset + ;; If point is in plain text found title is already one + ;; step forward. + (if (and (not contained) (>= offset 0)) -1 0)))) (goto-char (cond - ((and ttl (>= idx 0)) - (rst-Ttl-get-title-beginning ttl)) - ((> offset 0) + ((< target 0) + (point-min)) + ((>= target count) (point-max)) - ((point-min)))))) + ((and (not contained) (= offset 0)) + ;; Point not in title and should not move - do not move. + pnt) + ((rst-Ttl-get-title-beginning (nth target ttls))))))) -(defun rst-backward-section () - "Like `rst-forward-section', except move back one title." - (interactive) - (rst-forward-section -1)) +(defun rst-backward-section (offset) + "Like `rst-forward-section', except move backward by OFFSET." + (interactive "p") + (rst-forward-section (- offset))) -;; FIXME: What is `allow-extend' for? +;; FIXME: What is `allow-extend' for? See `mark-paragraph' for an explanation. (defun rst-mark-section (&optional count allow-extend) "Select COUNT sections around point. Mark following sections for positive COUNT or preceding sections @@ -3110,16 +3140,18 @@ The line containing the start of the region is always considered spanned. If the region ends at the beginning of a line this line is not considered spanned, otherwise it is spanned." (let (mincol) - (save-excursion - (goto-char beg) - (while (< (point) end) - (back-to-indentation) - (unless (looking-at (rst-re 'lin-end)) - (setq mincol (if mincol - (min mincol (current-column)) - (current-column)))) - (forward-line 1))) - mincol)) + (save-match-data + (save-excursion + (goto-char beg) + (1value + (rst-forward-line-strict 0)) + (while (< (point) end) + (unless (looking-at (rst-re 'lin-end)) + (setq mincol (if mincol + (min mincol (current-indentation)) + (current-indentation)))) + (rst-forward-line-strict 1 end))) + mincol))) ;; FIXME: At the moment only block comments with leading empty comment line are ;; supported. Comment lines with leading comment markup should be also @@ -3183,7 +3215,7 @@ COLUMN is the column of the tab. INNER is non-nil if this is an inner tab. I.e. a tab which does come from the basic indentation and not from inner alignment points." (save-excursion - (forward-line 0) + (rst-forward-line-strict 0) (save-match-data (unless (looking-at (rst-re 'lin-end)) (back-to-indentation) @@ -3205,7 +3237,8 @@ and not from inner alignment points." (if (zerop rst-indent-field) (push (list (match-end 2) (if (string= (match-string 2) "") 1 0) - t) tabs)))) + t) + tabs)))) ;; Directive. ((looking-at (rst-re 'dir-sta-3 '(:grp "\\S ") "?")) (push (list (match-end 1) 0 t) tabs) @@ -3223,16 +3256,18 @@ and not from inner alignment points." (push (list (point) rst-indent-comment t) tabs))) ;; Start of literal block. (when (looking-at (rst-re 'lit-sta-2)) - (let ((tab0 (first tabs))) - (push (list (first tab0) - (+ (second tab0) + (cl-destructuring-bind (point offset _inner) (car tabs) + (push (list point + (+ offset (if (match-string 1) rst-indent-literal-minimized rst-indent-literal-normal)) - t) tabs))) - (mapcar (lambda (tab) - (goto-char (first tab)) - (cons (+ (current-column) (second tab)) (third tab))) + t) + tabs))) + (mapcar (cl-function + (lambda ((point offset inner)) + (goto-char point) + (cons (+ (current-column) offset) inner))) tabs)))))) (defun rst-compute-tabs (pt) @@ -3242,38 +3277,35 @@ Return a list of tabs sorted by likeliness to continue writing like `rst-line-tabs'. Nearer lines have generally a higher likeliness than farther lines. Return nil if no tab is found in the text above." + ;; FIXME: See test `indent-for-tab-command-BUGS`. (save-excursion (goto-char pt) (let (leftmost ; Leftmost column found so far. innermost ; Leftmost column for inner tab. tablist) - (while (and (zerop (forward-line -1)) + (while (and (rst-forward-line-strict -1) (or (not leftmost) (> leftmost 0))) - (let* ((tabs (rst-line-tabs)) - (leftcol (if tabs (apply 'min (mapcar 'car tabs))))) + (let ((tabs (rst-line-tabs))) (when tabs - ;; Consider only lines indented less or same if not INNERMOST. - (when (or (not leftmost) - (< leftcol leftmost) - (and (not innermost) (= leftcol leftmost))) - (dolist (tab tabs) - (let ((inner (cdr tab)) - (newcol (car tab))) - (when (and - (or - (and (not inner) - (or (not leftmost) - (< newcol leftmost))) - (and inner - (or (not innermost) - (< newcol innermost)))) - (not (memq newcol tablist))) - (push newcol tablist)))) - (setq innermost (if (rst-some (mapcar 'cdr tabs)) ; Has inner. - leftcol - innermost)) - (setq leftmost leftcol))))) + (let ((leftcol (apply #'min (mapcar #'car tabs)))) + ;; Consider only lines indented less or same if not INNERMOST. + (when (or (not leftmost) + (< leftcol leftmost) + (and (not innermost) (= leftcol leftmost))) + (rst-destructuring-dolist ((column &rest inner) tabs) + (when (or + (and (not inner) + (or (not leftmost) + (< column leftmost))) + (and inner + (or (not innermost) + (< column innermost)))) + (setq tablist (cl-adjoin column tablist)))) + (setq innermost (if (cl-some #'cdr tabs) ; Has inner. + leftcol + innermost)) + (setq leftmost leftcol)))))) (nreverse tablist)))) (defun rst-indent-line (&optional dflt) @@ -3291,7 +3323,7 @@ relative to the content." (cur (current-indentation)) (clm (current-column)) (tabs (rst-compute-tabs (point))) - (fnd (rst-position cur tabs)) + (fnd (cl-position cur tabs :test #'equal)) ind) (if (and (not tabs) (not dflt)) 'noindent @@ -3315,7 +3347,9 @@ Shift by one tab to the right (CNT > 0) or left (CNT < 0) or remove all indentation (CNT = 0). A tab is taken from the text above. If no suitable tab is found `rst-indent-width' is used." (interactive "r\np") - (let ((tabs (sort (rst-compute-tabs beg) (lambda (x y) (<= x y)))) + (let ((tabs (sort (rst-compute-tabs beg) + #'(lambda (x y) + (<= x y)))) (leftmostcol (rst-find-leftmost-column beg end))) (when (or (> leftmostcol 0) (> cnt 0)) ;; Apply the indent. @@ -3324,17 +3358,15 @@ above. If no suitable tab is found `rst-indent-width' is used." (if (zerop cnt) (- leftmostcol) ;; Find the next tab after the leftmost column. - (let* ((cmp (if (> cnt 0) '> '<)) + (let* ((cmp (if (> cnt 0) #'> #'<)) (tabs (if (> cnt 0) tabs (reverse tabs))) (len (length tabs)) - (dir (rst-signum cnt)) ; Direction to take. + (dir (cl-signum cnt)) ; Direction to take. (abs (abs cnt)) ; Absolute number of steps to take. ;; Get the position of the first tab beyond leftmostcol. - (fnd (lexical-let ((cmp cmp) - (leftmostcol leftmostcol)) ;; Create closure. - (rst-position-if (lambda (elt) - (funcall cmp elt leftmostcol)) - tabs))) + (fnd (cl-position-if #'(lambda (elt) + (funcall cmp elt leftmostcol)) + tabs)) ;; Virtual position of tab. (pos (+ (or fnd len) (1- abs))) (tab (if (< pos len) @@ -3357,20 +3389,21 @@ above. If no suitable tab is found `rst-indent-width' is used." (defun rst-adaptive-fill () "Return fill prefix found at point. Value for `adaptive-fill-function'." - (let ((fnd (if (looking-at adaptive-fill-regexp) - (match-string-no-properties 0)))) - (if (save-match-data - (not (string-match comment-start-skip fnd))) - ;; An non-comment prefix is fine. - fnd - ;; Matches a comment - return whitespace instead. - (make-string (- - (save-excursion - (goto-char (match-end 0)) - (current-column)) - (save-excursion - (goto-char (match-beginning 0)) - (current-column))) ? )))) + (save-match-data + (let ((fnd (if (looking-at adaptive-fill-regexp) + (match-string-no-properties 0)))) + (if (save-match-data + (not (string-match comment-start-skip fnd))) + ;; An non-comment prefix is fine. + fnd + ;; Matches a comment - return whitespace instead. + (make-string (- + (save-excursion + (goto-char (match-end 0)) + (current-column)) + (save-excursion + (goto-char (match-beginning 0)) + (current-column))) ? ))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Comments @@ -3406,10 +3439,9 @@ Region is from BEG to END. Uncomment if ARG." (if (consp arg) (rst-uncomment-region beg end arg) (goto-char beg) + (rst-forward-line-strict 0) (let ((ind (current-indentation)) - bol) - (forward-line 0) - (setq bol (point)) + (bol (point))) (indent-rigidly bol end rst-indent-comment) (goto-char bol) (open-line 1) @@ -3420,14 +3452,13 @@ Region is from BEG to END. Uncomment if ARG." "Uncomment the current region. Region is from BEG to END. _ARG is ignored" (save-excursion - (let (bol eol) - (goto-char beg) - (forward-line 0) - (setq bol (point)) - (forward-line 1) - (setq eol (point)) - (indent-rigidly eol end (- rst-indent-comment)) - (delete-region bol eol)))) + (goto-char beg) + (rst-forward-line-strict 0) + (let ((bol (point))) + (rst-forward-line-strict 1 end) + (indent-rigidly (point) end (- rst-indent-comment)) + (goto-char bol) + (rst-delete-entire-line 0)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Apply to indented block @@ -3445,95 +3476,94 @@ containing or after BEG and indented to IND. After the first line the indented block may contain more lines with same indentation (the paragraph) followed by empty lines and lines more indented (the sub-blocks). A following line indented to IND -starts the next indented block. A line with less indentation -than IND terminates the current indented block. Such lines and -all following lines not indented to IND are skipped. FUN is -applied to unskipped lines like this - - (FUN COUNT FIRSTP SUBP EMPTYP RELIND LASTRET) - -COUNT is 0 before the first indented block and increments for -every indented block found. - -FIRSTP is t when this is the first line of the paragraph. - -SUBP is t when this line is part of a sub-block. - -EMPTYP is t when this line is empty. - -RELIND is nil for an empty line, 0 for a line indented to IND, -and the number of columns more indented otherwise. - -LASTRET is the return value of FUN returned by the last -invocation for the same indented block or nil for the first -invocation. - -When FUN is called point is immediately behind indentation of -that line. FUN may change everything as long as a marker at END -is handled correctly by the change. - -Return the return value of the last invocation of FUN or nil if -FUN was never called." - (let (lastret - subp - skipping - nextm - (count 0) ; Before first indented block - (endm (copy-marker end t))) - (save-excursion - (goto-char beg) - (while (< (point) endm) - (save-excursion - (setq nextm (save-excursion - (forward-line 1) - (copy-marker (point) t))) +starts the next paragraph. A non-empty line with less +indentation than IND terminates the current paragraph. FUN is +applied to each line like this + + (FUN COUNT IN-FIRST IN-SUB IN-SUPER IN-EMPTY RELIND) + +COUNT is 0 before the first paragraph and increments for every +paragraph found on level IND. IN-FIRST is non-nil if this is the +first line of such a paragraph. IN-SUB is non-nil if this line +is part of a sub-block while IN-SUPER is non-nil of this line is +part of a less indented block (super-block). IN-EMPTY is non-nil +if this line is empty where an empty line is considered being +part of the previous block. RELIND is nil for an empty line, 0 +for a line indented to IND, and the positive or negative number +of columns more or less indented otherwise. When FUN is called +point is immediately behind indentation of that line. FUN may +change everything as long as a marker at END and at the beginning +of the following line is handled correctly by the change. A +non-nil return value from FUN breaks the loop and is returned. +Otherwise return nil." + (let ((endm (copy-marker end t)) + (count 0) ; Before first indented block. + (nxt (when (< beg end) + (copy-marker beg t))) + (broken t) + in-sub in-super stop) + (save-match-data + (save-excursion + (while (and (not stop) nxt) + (set-marker + (goto-char nxt) nil) + (setq nxt (save-excursion + ;; FIXME refactoring: Replace `(forward-line) + ;; (back-to-indentation)` by + ;; `(forward-to-indentation)` + (when (and (rst-forward-line-strict 1 endm) + (< (point) endm)) + (copy-marker (point) t)))) (back-to-indentation) - (let (firstp - emptyp - (relind (- (current-column) ind))) + (let ((relind (- (current-indentation) ind)) + (in-empty (looking-at (rst-re 'lin-end))) + in-first) (cond - ((looking-at (rst-re 'lin-end)) - (setq emptyp t) - (setq relind nil) - ;; Breaks indented block if one is started - (setq subp (not (zerop count)))) - ((< relind 0) ; Less indented - (setq skipping t)) - ((zerop relind) ; In indented block - (when (or subp skipping (zerop count)) - (setq firstp t) - (incf count)) - (setq subp nil) - (setq skipping nil)) - (t ; More indented - (setq subp t))) - (unless skipping - (setq lastret - (funcall fun count firstp subp emptyp relind lastret))))) - (goto-char nextm)) - lastret))) + (in-empty + (setq relind nil)) + ((< relind 0) + (setq in-sub nil) + (setq in-super t)) + ((> relind 0) + (setq in-sub t) + (setq in-super nil)) + (t ; Non-empty line in indented block. + (when (or broken in-sub in-super) + (setq in-first t) + (cl-incf count)) + (setq in-sub nil) + (setq in-super nil))) + (save-excursion + (setq + stop + (funcall fun count in-first in-sub in-super in-empty relind))) + (setq broken in-empty))) + (set-marker endm nil) + stop)))) (defun rst-enumerate-region (beg end all) "Add enumeration to all the leftmost paragraphs in the given region. The region is specified between BEG and END. With ALL, do all lines instead of just paragraphs." (interactive "r\nP") - (let ((enum 0)) + (let ((enum 0) + (indent "")) (rst-apply-indented-blocks beg end (rst-find-leftmost-column beg end) - (lambda (count firstp subp emptyp relind lastret) - (cond - (emptyp) - ((zerop count)) - (subp - (insert lastret)) - ((or firstp all) - (let ((ins (format "%d. " (incf enum)))) - (setq lastret (make-string (length ins) ?\ )) - (insert ins))) - (t - (insert lastret))) - lastret)))) + #'(lambda (count in-first in-sub in-super in-empty _relind) + (cond + (in-empty) + (in-super) + ((zerop count)) + (in-sub + (insert indent)) + ((or in-first all) + (let ((tag (format "%d. " (cl-incf enum)))) + (setq indent (make-string (length tag) ? )) + (insert tag))) + (t + (insert indent))) + nil)))) ;; FIXME: Does not deal with deeper indentation - although ;; `rst-apply-indented-blocks' could. @@ -3544,21 +3574,22 @@ do all lines instead of just paragraphs." (interactive "r\nP") (unless rst-preferred-bullets (error "No preferred bullets defined")) - (let ((bul (format "%c " (car rst-preferred-bullets))) - (cont " ")) + (let* ((bul (format "%c " (car rst-preferred-bullets))) + (indent (make-string (length bul) ? ))) (rst-apply-indented-blocks beg end (rst-find-leftmost-column beg end) - (lambda (count firstp subp emptyp relind lastret) - (cond - (emptyp) - ((zerop count)) - (subp - (insert cont)) - ((or firstp all) - (insert bul)) - (t - (insert cont))) - nil)))) + #'(lambda (count in-first in-sub in-super in-empty _relind) + (cond + (in-empty) + (in-super) + ((zerop count)) + (in-sub + (insert indent)) + ((or in-first all) + (insert bul)) + (t + (insert indent))) + nil)))) ;; FIXME: Does not deal with a varying number of digits appropriately. ;; FIXME: Does not deal with multiple levels independently. @@ -3567,19 +3598,19 @@ do all lines instead of just paragraphs." "Convert the bulleted and enumerated items in the region to enumerated lists. Renumber as necessary. Region is from BEG to END." (interactive "r") - (let* (;; Find items and convert the positions to markers. - (items (mapcar - (lambda (x) - (cons (copy-marker (car x)) - (cdr x))) - (rst-find-pfx-in-region beg end (rst-re 'itmany-sta-1)))) - (count 1)) - (save-excursion - (dolist (x items) - (goto-char (car x)) - (looking-at (rst-re 'itmany-beg-1)) - (replace-match (format "%d." count) nil nil nil 1) - (incf count))))) + (let ((count 1)) + (save-match-data + (save-excursion + (dolist (marker (mapcar + (cl-function + (lambda ((pnt &rest clm)) + (copy-marker pnt))) + (rst-find-begs beg end 'itmany-beg-1))) + (set-marker + (goto-char marker) nil) + (looking-at (rst-re 'itmany-beg-1)) + (replace-match (format "%d." count) nil nil nil 1) + (cl-incf count)))))) (defun rst-line-block-region (beg end &optional with-empty) "Add line block prefixes for a region. @@ -3588,10 +3619,11 @@ Region is from BEG to END. With WITH-EMPTY prefix empty lines too." (let ((ind (rst-find-leftmost-column beg end))) (rst-apply-indented-blocks beg end ind - (lambda (count firstp subp emptyp relind lastret) - (when (or with-empty (not emptyp)) - (move-to-column ind t) - (insert "| ")))))) + #'(lambda (_count _in-first _in-sub in-super in-empty _relind) + (when (and (not in-super) (or with-empty (not in-empty))) + (move-to-column ind t) + (insert "| ")) + nil)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -4040,14 +4072,16 @@ Return nil if not or a cons with new values for BEG / END" (if (or nbeg nend) (cons (or nbeg beg) (or nend end))))) +;; FIXME refactoring: Use `rst-forward-line-strict' instead. (defun rst-forward-line (&optional n) "Like `forward-line' but always end up in column 0 and return accordingly. Move N lines forward just as `forward-line'." - (let ((moved (forward-line n))) + (let ((left (forward-line n))) (if (bolp) - moved + left + ;; FIXME: This may move back for positive n - is this desired? (forward-line 0) - (- moved (rst-signum n))))) + (- left (cl-signum n))))) ;; FIXME: If a single line is made a section header by `rst-adjust' the header ;; is not always fontified immediately. @@ -4068,77 +4102,73 @@ Return extended point or nil if not moved." ;; The second group consists of the adornment cases. (if (not (get-text-property pt 'font-lock-multiline)) ;; Move only if we don't start inside a multiline construct already. - (save-excursion - (let (;; Non-empty non-indented line, explicit markup tag or literal - ;; block tag. - (stop-re (rst-re '(:alt "[^ \t\n]" - (:seq hws-tag exm-tag) - (:seq ".*" dcl-tag lin-end))))) - ;; The comments below are for dir == -1 / dir == 1. - (goto-char pt) - (forward-line 0) - (setq pt (point)) - (while (and (not (looking-at stop-re)) - (zerop (rst-forward-line dir)))) ; try previous / next - ; line if it exists. - (if (looking-at (rst-re 'ado-beg-2-1)) ; may be an underline / - ; overline. - (if (zerop (rst-forward-line dir)) - (if (looking-at (rst-re 'ttl-beg-1)) ; title found, i.e. - ; underline / overline - ; found. - (if (zerop (rst-forward-line dir)) - (if (not - (looking-at (rst-re 'ado-beg-2-1))) ; no - ; overline / - ; underline. - (rst-forward-line (- dir)))) ; step back to title - ; / adornment. - (if (< dir 0) ; keep downward adornment. - (rst-forward-line (- dir))))) ; step back to adornment. - (if (looking-at (rst-re 'ttl-beg-1)) ; may be a title. + (save-match-data + (save-excursion + (let ( ; Non-empty non-indented line, explicit markup tag or literal + ; block tag. + (stop-re (rst-re '(:alt "[^ \t\n]" + (:seq hws-tag exm-tag) + (:seq ".*" dcl-tag lin-end))))) + ;; The comments below are for dir == -1 / dir == 1. + (goto-char pt) + (rst-forward-line-strict 0) + (setq pt (point)) + (while (and (not (looking-at stop-re)) + (zerop (rst-forward-line dir)))) ; try previous / next + ; line if it exists. + (if (looking-at (rst-re 'ado-beg-2-1)) ; may be an underline / + ; overline. (if (zerop (rst-forward-line dir)) - (if (not - (looking-at (rst-re 'ado-beg-2-1))) ; no overline / - ; underline. - (rst-forward-line (- dir)))))) ; step back to line. - (if (not (= (point) pt)) - (point)))))) + (if (looking-at (rst-re 'ttl-beg-1)) ; title found, i.e. + ; underline / overline + ; found. + (if (zerop (rst-forward-line dir)) + (if (not + (looking-at (rst-re 'ado-beg-2-1))) ; no + ; overline + ; / + ; underline. + (rst-forward-line (- dir)))) ; step back to + ; title / + ; adornment. + (if (< dir 0) ; keep downward adornment. + (rst-forward-line (- dir))))) ; step back to adornment. + (if (looking-at (rst-re 'ttl-beg-1)) ; may be a title. + (if (zerop (rst-forward-line dir)) + (if (not + (looking-at (rst-re 'ado-beg-2-1))) ; no overline / + ; underline. + (rst-forward-line (- dir)))))) ; step back to line. + (if (not (= (point) pt)) + (point))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Indented blocks (defun rst-forward-indented-block (&optional column limit) + ;; testcover: ok. "Move forward across one indented block. -Find the next non-empty line which is not indented at least to COLUMN (defaults -to the column of the point). Moves point to first character of this line or the -first empty line immediately before it and returns that position. If there is -no such line before LIMIT (defaults to the end of the buffer) returns nil and -point is not moved." - (interactive) - (let ((clm (or column (current-column))) - (start (point)) - fnd beg cand) - (if (not limit) - (setq limit (point-max))) - (save-match-data - (while (and (not fnd) (< (point) limit)) - (forward-line 1) - (when (< (point) limit) - (setq beg (point)) - (if (looking-at (rst-re 'lin-end)) - (setq cand (or cand beg)) ; An empty line is a candidate. - (move-to-column clm) - ;; FIXME: No indentation [(zerop clm)] must be handled in some - ;; useful way - though it is not clear what this should mean - ;; at all. - (if (string-match - (rst-re 'linemp-tag) - (buffer-substring-no-properties beg (point))) - (setq cand nil) ; An indented line resets a candidate. - (setq fnd (or cand beg))))))) - (goto-char (or fnd start)) - fnd)) +Find the next non-empty line which is not indented at least to +COLUMN (defaults to the column of the point). Moves point to +first character of this line or the first of the empty lines +immediately before it and returns that position. If there is no +such line before LIMIT (defaults to the end of the buffer) +returns nil and point is not moved." + (let (fnd candidate) + (setq fnd (rst-apply-indented-blocks + (point) (or limit (point-max)) (or column (current-column)) + #'(lambda (_count _in-first _in-sub in-super in-empty _relind) + (cond + (in-empty + (setq candidate (or candidate (line-beginning-position))) + nil) + (in-super + (or candidate (line-beginning-position))) + (t ; Non-empty, same or more indented line. + (setq candidate nil) + nil))))) + (when fnd + (goto-char fnd)))) (defvar rst-font-lock-find-unindented-line-begin nil "Beginning of the match if `rst-font-lock-find-unindented-line-end'.") @@ -4156,42 +4186,43 @@ IND-PNT is non-nil but not a number take the indentation from the next non-empty line if this is indented more than the current one." (setq rst-font-lock-find-unindented-line-begin ind-pnt) (setq rst-font-lock-find-unindented-line-end - (save-excursion - (when (not (numberp ind-pnt)) - ;; Find indentation point in next line if any. - (setq ind-pnt - ;; FIXME: Should be refactored to two different functions - ;; giving their result to this function, may be - ;; integrated in caller. - (save-match-data - (let ((cur-ind (current-indentation))) - (if (eq ind-pnt 'next) - (when (and (zerop (forward-line 1)) - (< (point) (point-max))) - ;; Not at EOF. - (setq rst-font-lock-find-unindented-line-begin - (point)) - (when (and (not (looking-at (rst-re 'lin-end))) - (> (current-indentation) cur-ind)) + (save-match-data + (save-excursion + (when (not (numberp ind-pnt)) + ;; Find indentation point in next line if any. + (setq ind-pnt + ;; FIXME: Should be refactored to two different functions + ;; giving their result to this function, may be + ;; integrated in caller. + (save-match-data + (let ((cur-ind (current-indentation))) + (if (eq ind-pnt 'next) + (when (and (rst-forward-line-strict 1 (point-max)) + (< (point) (point-max))) + ;; Not at EOF. + (setq rst-font-lock-find-unindented-line-begin + (point)) + (when (and (not (looking-at (rst-re 'lin-end))) + (> (current-indentation) cur-ind)) ;; Use end of indentation if non-empty line. (looking-at (rst-re 'hws-tag)) (match-end 0))) - ;; Skip until non-empty line or EOF. - (while (and (zerop (forward-line 1)) - (< (point) (point-max)) - (looking-at (rst-re 'lin-end)))) - (when (< (point) (point-max)) - ;; Not at EOF. - (setq rst-font-lock-find-unindented-line-begin - (point)) - (when (> (current-indentation) cur-ind) - ;; Indentation bigger than line of departure. - (looking-at (rst-re 'hws-tag)) - (match-end 0)))))))) - (when ind-pnt - (goto-char ind-pnt) - (or (rst-forward-indented-block nil (point-max)) - (point-max)))))) + ;; Skip until non-empty line or EOF. + (while (and (rst-forward-line-strict 1 (point-max)) + (< (point) (point-max)) + (looking-at (rst-re 'lin-end)))) + (when (< (point) (point-max)) + ;; Not at EOF. + (setq rst-font-lock-find-unindented-line-begin + (point)) + (when (> (current-indentation) cur-ind) + ;; Indentation bigger than line of departure. + (looking-at (rst-re 'hws-tag)) + (match-end 0)))))))) + (when ind-pnt + (goto-char ind-pnt) + (or (rst-forward-indented-block nil (point-max)) + (point-max))))))) (defun rst-font-lock-find-unindented-line-match (_limit) "Set the match found earlier if match were found. @@ -4359,33 +4390,31 @@ select the alternative tool-set." (interactive "P") ;; Note: maybe we want to check if there is a Makefile too and not do anything ;; if that is the case. I dunno. - (let* ((toolset (cdr (assq (if use-alt - rst-compile-secondary-toolset - rst-compile-primary-toolset) - rst-compile-toolsets))) - (command (car toolset)) - (extension (cadr toolset)) - (options (caddr toolset)) - (conffile (rst-compile-find-conf)) - (bufname (file-name-nondirectory buffer-file-name)) - (outname (file-name-sans-extension bufname))) - + (cl-destructuring-bind + (command extension options + &aux (conffile (rst-compile-find-conf)) + (bufname (file-name-nondirectory buffer-file-name))) + (cdr (assq (if use-alt + rst-compile-secondary-toolset + rst-compile-primary-toolset) + rst-compile-toolsets)) ;; Set compile-command before invocation of compile. (setq-local compile-command - (mapconcat 'identity - (list command - (or options "") - (if conffile - (concat "--config=" (shell-quote-argument conffile)) - "") - (shell-quote-argument bufname) - (shell-quote-argument (concat outname extension))) - " ")) - + (mapconcat + #'identity + (list command + (or options "") + (if conffile + (concat "--config=" (shell-quote-argument conffile)) + "") + (shell-quote-argument bufname) + (shell-quote-argument (concat (file-name-sans-extension bufname) + extension))) + " ")) ;; Invoke the compile command. (if (or compilation-read-command use-alt) - (call-interactively 'compile) + (call-interactively #'compile) (compile compile-command)))) (defun rst-compile-alt-toolset () @@ -4443,6 +4472,10 @@ buffer, if the region is not selected." ;; FIXME: Add `rst-compile-html-preview'. +;; FIXME: Add support for `restview` (http://mg.pov.lt/restview/). May be a +;; more general facility for calling commands on a reST file would make +;; sense. + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Imenu support @@ -4470,12 +4503,12 @@ buffer, if the region is not selected." ;; become visible even for long title lines. May be an additional ;; level number is also useful. (setq name (format "%s%s%s" pfx txt sfx)) - (cons name ;; The name of the entry. + (cons name ; The name of the entry. (if children - (cons ;; The entry has a submenu. - (cons name pos) ;; The entry itself. - (mapcar 'rst-imenu-convert-cell children)) ;; The children. - pos)))) ;; The position of a plain entry. + (cons ; The entry has a submenu. + (cons name pos) ; The entry itself. + (mapcar #'rst-imenu-convert-cell children)) ; The children. + pos)))) ; The position of a plain entry. ;; FIXME: Document title and subtitle need to be handled properly. They should ;; get an own "Document" top level entry. @@ -4485,7 +4518,7 @@ Return as described for `imenu--index-alist'." (rst-reset-section-caches) (let ((root (rst-all-stn))) (when root - (mapcar 'rst-imenu-convert-cell (rst-Stn-children root))))) + (mapcar #'rst-imenu-convert-cell (rst-Stn-children root))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -4504,7 +4537,7 @@ cand replace with char: ") (setq found (1+ found)) (goto-char (match-beginning 1)) (let ((width (current-column))) - (rst-delete-entire-line) + (rst-delete-entire-line 0) (insert-char tochar width))) (message "%d lines replaced." found)))) @@ -4513,7 +4546,7 @@ cand replace with char: ") "Join lines in current paragraph into one line, removing end-of-lines." (interactive) (let ((fill-column 65000)) ; Some big number. - (call-interactively 'fill-paragraph))) + (call-interactively #'fill-paragraph))) ;; FIXME: Unbound command - should be bound or removed. (defun rst-force-fill-paragraph () commit e28c99082ac03b06600b8b943704e0786c8887f9 Author: Stefan Monnier Date: Tue Jan 3 16:07:44 2017 -0500 (cl-defstruct): Improve error message for slots w/o value (bug#25312) * lisp/emacs-lisp/cl-macs.el (cl-defstruct): Don't signal an error but emit a warning for those coders who forgot to put a default value in their slot. diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 945da1fb39..40342f3fe4 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -2745,7 +2745,23 @@ non-nil value, that slot cannot be set via `setf'. `(nth ,pos cl-x)))) forms) (when (cl-oddp (length desc)) - (error "Invalid options for slot %s in %s" slot name)) + (push + (macroexp--warn-and-return + (format "Missing value for option `%S' of slot `%s' in struct %s!" + (car (last desc)) slot name) + 'nil) + forms) + (when (and (keywordp (car defaults)) + (not (keywordp (car desc)))) + (let ((kw (car defaults))) + (push + (macroexp--warn-and-return + (format " I'll take `%s' to be an option rather than a default value." + kw) + 'nil) + forms) + (push kw desc) + (setcar defaults nil)))) (if (plist-get desc ':read-only) (push `(gv-define-expander ,accessor (lambda (_cl-do _cl-x) commit 5c6f1198d40b404573e5dfd2b0f1e5c73f71209b Author: Philipp Stephani Date: Tue Jan 3 16:24:23 2017 +0000 Small patch for ffap.el * lisp/ffap.el (ffap-alist): Document that ffap sets the match data while walking 'ffap-alist'. diff --git a/lisp/ffap.el b/lisp/ffap.el index cabf339501..8144d41f3a 100644 --- a/lisp/ffap.el +++ b/lisp/ffap.el @@ -797,7 +797,10 @@ specify actions to try creating such a string. A pair matches if either KEY is a symbol, and it equals `major-mode', or KEY is a string, it should match NAME as a regexp. On a match, (FUNCTION NAME) is called and should return a file, an -URL, or nil. If nil, search the alist for further matches.") +URL, or nil. If nil, search the alist for further matches. +While calling FUNCTION, the match data is set according to KEY if KEY +is a string, so that FUNCTION can use `match-string' and friends +to extract substrings.") (put 'ffap-alist 'risky-local-variable t) commit 10444dcf77711bf3360f865fcb0d446a83e1bfb5 Author: Eli Zaretskii Date: Tue Jan 3 17:46:40 2017 +0200 Generate nt/gnulib.mk from lib/gnulib.mk This was proposed by Paul Eggert , with the purpose of avoiding manual maintenance of nt/gnulib.mk. * nt/gnulib-modules-to-delete.cfg: New file. * nt/Makefile.in (AM_V_GEN, am__v_GEN_, am__v_GEN_0) (am__v_GEN_1): New variables. (${srcdir}/gnulib.mk): Rules to generate gnulib.mk from lib/gnulib.mk and list of modules in gnulib-modules-to-delete.cfg. * make-dist (nt): Add gnulib-modules-to-delete.cfg to the list of files to link. * configure.ac (GNULIB_MK): Compute the value according to $opsys. * autogen.sh: Create nt/gnulib.mk if it doesn't exist, before running autoreconf. * Makefile.in (gnulib_mk): New variable. ($(srcdir)/nt/gnulib.mk): Rule to produce it. (AUTOMAKE_INPUTS): Use $(gnulib_mk) instead of a literal file name. * .gitignore: Add nt/gnulib.mk. * src/w32.c (acl_errno_valid): Implement it here, as we no longer build the acl-permissions module from Gnulib. diff --git a/.gitignore b/.gitignore index 85c06c9b49..e8eb4fdeae 100644 --- a/.gitignore +++ b/.gitignore @@ -288,5 +288,6 @@ lib/SYS/ /site-lisp/ nt/emacs.rc nt/emacsclient.rc +nt/gnulib.mk src/gdb.ini /var/ diff --git a/Makefile.in b/Makefile.in index 3cb1f5e2ab..b9aaf5babc 100644 --- a/Makefile.in +++ b/Makefile.in @@ -98,6 +98,9 @@ configuration=@configuration@ ### The nt/ subdirectory gets built only for MinGW NTDIR=@NTDIR@ +### $(srcdir)/nt/gnulib.mk for MinGW, else $(srcdir)/lib/gnulib.mk +gnulib_mk=@GNULIB_MK@ + # 'make' verbosity. AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@ @@ -451,10 +454,13 @@ $(srcdir)/aclocal.m4: $(ACLOCAL_INPUTS) cd $(srcdir) && ACLOCAL_PATH='$(ACLOCAL_PATH)' $(ACLOCAL) -I m4 AUTOMAKE_INPUTS = $(srcdir)/aclocal.m4 $(srcdir)/lib/Makefile.am \ - $(srcdir)/lib/gnulib.mk + $(gnulib_mk) $(srcdir)/lib/Makefile.in: $(AUTOMAKE_INPUTS) cd $(srcdir) && $(AUTOMAKE) --gnu -a -c lib/Makefile +$(srcdir)/nt/gnulib.mk: $(srcdir)/lib/Makefile.in + $(MAKE) -C $(srcdir)/nt gnulib.mk + # Regenerate files that this makefile would have made, if this makefile # had been built by Automake. The name 'am--refresh' is for # compatibility with subsidiary Automake-generated makefiles. diff --git a/autogen.sh b/autogen.sh index 7381bc3234..91e1e2cea2 100755 --- a/autogen.sh +++ b/autogen.sh @@ -220,8 +220,13 @@ Please report any problems with this script to bug-gnu-emacs@gnu.org .' fi echo 'Your system has the required tools.' - echo "Running 'autoreconf -fi -I m4' ..." + ## Create nt/gnulib.mk if it doesn't exist, as autoreconf will need it. + if test ! -f nt/gnulib.mk; then + sed '/^[^#]/s|^.*$|/^## begin *gnulib module &/,/^## end *gnulib module &/c ## gnulib module & removed|' nt/gnulib-modules-to-delete.cfg | sed -f- lib/gnulib.mk > nt/gnulib.mk + fi + + echo "Running 'autoreconf -fi -I m4' ..." ## Let autoreconf figure out what, if anything, needs doing. ## Use autoreconf's -f option in case autoreconf itself has changed. diff --git a/configure.ac b/configure.ac index ce386f6c6c..262f367f2c 100644 --- a/configure.ac +++ b/configure.ac @@ -774,6 +774,17 @@ fi dnl This is used in lib/Makefile.am to use nt/gnulib.mk, the dnl alternative to lib/gnulib.mk, so as to avoid generating header files dnl that clash with MinGW. +case $opsys in + mingw32 ) + GNULIB_MK='$(srcdir)/nt/gnulib.mk' + ;; + * ) + GNULIB_MK='$(srcdir)/lib/gnulib.mk' + ;; + +esac +AC_SUBST([GNULIB_MK]) + AM_CONDITIONAL([BUILDING_FOR_WINDOWSNT], [test "x$opsys" = "xmingw32"]) # Avoid gnulib's tests for -lcrypto, so that there's no static dependency on it. diff --git a/make-dist b/make-dist index 6513cca392..41203b20aa 100755 --- a/make-dist +++ b/make-dist @@ -482,7 +482,7 @@ echo "Making links to 'nt'" (cd nt ln emacs-x86.manifest emacs-x64.manifest ../${tempdir}/nt ln [a-z]*.bat [a-z]*.[ch] ../${tempdir}/nt - ln *.in gnulib.mk ../${tempdir}/nt + ln *.in gnulib.mk gnulib-modules-to-delete.cfg ../${tempdir}/nt ln mingw-cfg.site epaths.nt INSTALL.W64 ../${tempdir}/nt ln ChangeLog.*[0-9] INSTALL README README.W32 ../${tempdir}/nt) diff --git a/nt/Makefile.in b/nt/Makefile.in index 7e911db7aa..89f44606d7 100644 --- a/nt/Makefile.in +++ b/nt/Makefile.in @@ -54,6 +54,11 @@ am__v_CCLD_ = $(am__v_CCLD_@AM_DEFAULT_V@) am__v_CCLD_0 = @echo " CCLD " $@; am__v_CCLD_1 = +AM_V_GEN = $(am__v_GEN_@AM_V@) +am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@) +am__v_GEN_0 = @echo " GEN " $@; +am__v_GEN_1 = + AM_V_RC = $(am__v_RC_@AM_V@) am__v_RC_ = $(am__v_RC_@AM_DEFAULT_V@) am__v_RC_0 = @echo " RC " $@; @@ -255,3 +260,8 @@ runemacs${EXEEXT}: ${srcdir}/runemacs.c $(EMACSRES) emacs.res ../src/emacs.res: emacs.rc ${srcdir}/icons/emacs.ico \ ${srcdir}/icons/hand.cur ${srcdir}/$(EMACS_MANIFEST) $(AM_V_RC)${WINDRES} -I ${srcdir} -O coff -o $@ $< + +${srcdir}/gnulib.mk: ${srcdir}/gnulib-modules-to-delete.cfg ${srcdir}/../lib/gnulib.mk + $(AM_V_GEN)sed '/^[^#]/s|^.*$$|/^## begin *gnulib module &/,/^## end *gnulib module &/c ## gnulib module & removed|' < $< | \ + sed -f- ${srcdir}/../lib/gnulib.mk > $@-t && \ + ${srcdir}/../build-aux/move-if-change $@-t $@ diff --git a/nt/gnulib-modules-to-delete.cfg b/nt/gnulib-modules-to-delete.cfg new file mode 100644 index 0000000000..09bea0ee6a --- /dev/null +++ b/nt/gnulib-modules-to-delete.cfg @@ -0,0 +1,66 @@ +# This is the list of modules to be deleted from ../lib/gnulib.mk. +# +# We delete them because they either conflict with MinGW headers or +# headers in nt/inc, or because those modules won't compile with +# MinGW, or because Emacs already has the corresponding facilities as +# part of Emacs sources, and their implementation is incompatible with +# Gnulib's. +# +# In general, do NOT remove anything from ../lib/gnulib.mk that +# doesn't need to be removed, to minimize the differences from +# upstream gnulib.mk and thus make the maintenance easier. Every +# header file whose generation is controlled by configure-time tests +# does NOT need to be removed; instead, force the configure script to +# accept whatever MinGW has to offer, by defining the appropriate +# Autoconf variable in the nt/mingw-cfg.site file. Headers that are +# generated conditionally have the tell-tale "if GL_GENERATE_foo_H" +# condition before their Makefile snippet in this file. Likewise, do +# NOT remove gnulib modules which introduce header files that don't +# exist in MinGW and in nt/inc/, since they cannot possibly clash +# with anything. Gnulib modules that introduce source *.c files also +# need not be removed; if they define functions that could clash with +# the w32 substitutes in Emacs, disable their compilation by defining +# suitable variables in nt/mingw-cfg.site. +# ---------------------------------------------------------------------- +# +# Copyright (C) 2017 Free Software Foundation, Inc. +# +# This file is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. +# +# This file is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this file. If not, see . +# +# As a special exception to the GNU General Public License, +# this file may be distributed as part of a program that +# contains a configuration script generated by Autoconf, under +# the same distribution terms as the rest of that program. +# +acl-permissions +allocator +at-internal +careadlinkat +dirent +dirfd +fcntl +fcntl-h +inttypes-incomplete +mkostemp +pipe2 +secure_getenv +signal-h +stdio +stdlib +sys_select +sys_stat +sys_time +sys_types +tempname +unistd diff --git a/nt/gnulib.mk b/nt/gnulib.mk deleted file mode 100644 index 87b47a3bf5..0000000000 --- a/nt/gnulib.mk +++ /dev/null @@ -1,1151 +0,0 @@ -## This file is an edited copy of ../lib/gnulib.mk. -## -## The purpose of the edits is to avoid generating any headers -## which would conflict with either the headers we have in nt/inc, -## or with MinGW system headers and subsequent redirection of some -## functions in nt/inc/ms-w32.h. -## -## In general, do NOT remove anything from ../lib/gnulib.mk that -## doesn't need to be removed, to minimize the differences from -## upstream gnulib.mk and thus make the maintenance easier. Every -## header file whose generation is controlled by configure-time tests -## does NOT need to be removed; instead, force the configure script to -## accept whatever MinGW has to offer, by defining the appropriate -## Autoconf variable in the nt/mingw-cfg.site file. Headers that are -## generated conditionally have the tell-tale "if GL_GENERATE_foo_H" -## condition before their Makefile snippet in this file. Likewise, do -## NOT remove gnulib modules which introduce header files that don't -## exist in MinGW and in nt/inc/, since they cannot possibly clash -## with anything. Gnulib modules that introduce source *.c files also -## need not be removed; if they define functions that could clash with -## the w32 substitutes in Emacs, disable their compilation by defining -## suitable variables in nt/mingw-cfg.site. -## -## Process this file with automake to produce Makefile.in. -# Copyright (C) 2002-2017 Free Software Foundation, Inc. -# -# This file is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 3 of the License, or -# (at your option) any later version. -# -# This file is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this file. If not, see . -# -# As a special exception to the GNU General Public License, -# this file may be distributed as part of a program that -# contains a configuration script generated by Autoconf, under -# the same distribution terms as the rest of that program. -# -# Generated by gnulib-tool. -# Reproduce by: gnulib-tool --import --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --avoid=close --avoid=dup --avoid=fchdir --avoid=flexmember --avoid=fstat --avoid=malloc-posix --avoid=msvc-inval --avoid=msvc-nothrow --avoid=open --avoid=openat-die --avoid=opendir --avoid=raise --avoid=save-cwd --avoid=select --avoid=setenv --avoid=sigprocmask --avoid=stdarg --avoid=stdbool --avoid=threadlib --avoid=unsetenv --makefile-name=gnulib.mk --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files alloca-opt binary-io byteswap c-ctype c-strcase careadlinkat close-stream count-one-bits count-trailing-zeros crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 dtoastr dtotimespec dup2 environ execinfo faccessat fcntl fcntl-h fdatasync fdopendir filemode filevercmp fstatat fsync getloadavg getopt-gnu gettime gettimeofday gitlog-to-changelog ignore-value intprops largefile lstat manywarnings memrchr mkostemp mktime pipe2 pselect pthread_sigmask putenv qcopy-acl readlink readlinkat sig2str socklen stat-time std-gnu11 stdalign stddef stdio stpcpy strftime strtoimax strtoumax symlink sys_stat sys_time time time_r time_rz timegm timer-time timespec-add timespec-sub unsetenv update-copyright utimens vla warnings - - -MOSTLYCLEANFILES += core *.stackdump - -noinst_LIBRARIES += libgnu.a - -libgnu_a_SOURCES = -libgnu_a_LIBADD = $(gl_LIBOBJS) -libgnu_a_DEPENDENCIES = $(gl_LIBOBJS) -EXTRA_libgnu_a_SOURCES = - -## begin gnulib module absolute-header - -# Use this preprocessor expression to decide whether #include_next works. -# Do not rely on a 'configure'-time test for this, since the expression -# might appear in an installed header, which is used by some other compiler. -HAVE_INCLUDE_NEXT = (__GNUC__ || 60000000 <= __DECC_VER) - -## end gnulib module absolute-header - -## begin gnulib module acl-permissions - -libgnu_a_SOURCES += acl-errno-valid.c acl-internal.c \ - get-permissions.c - -EXTRA_DIST += acl-internal.h acl.h acl_entries.c - -EXTRA_libgnu_a_SOURCES += acl_entries.c - -## end gnulib module acl-permissions - -## begin gnulib module alloca-opt - -BUILT_SOURCES += $(ALLOCA_H) - -# We need the following in order to create when the system -# doesn't have one that works with the given compiler. -if GL_GENERATE_ALLOCA_H -alloca.h: alloca.in.h $(top_builddir)/config.status - $(AM_V_GEN)rm -f $@-t $@ && \ - { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \ - cat $(srcdir)/alloca.in.h; \ - } > $@-t && \ - mv -f $@-t $@ -else -alloca.h: $(top_builddir)/config.status - rm -f $@ -endif -MOSTLYCLEANFILES += alloca.h alloca.h-t - -EXTRA_DIST += alloca.in.h - -## end gnulib module alloca-opt - -## begin gnulib module binary-io - -libgnu_a_SOURCES += binary-io.h binary-io.c - -## end gnulib module binary-io - -## begin gnulib module byteswap - -BUILT_SOURCES += $(BYTESWAP_H) - -# We need the following in order to create when the system -# doesn't have one. -if GL_GENERATE_BYTESWAP_H -byteswap.h: byteswap.in.h $(top_builddir)/config.status - $(AM_V_GEN)rm -f $@-t $@ && \ - { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \ - cat $(srcdir)/byteswap.in.h; \ - } > $@-t && \ - mv -f $@-t $@ -else -byteswap.h: $(top_builddir)/config.status - rm -f $@ -endif -MOSTLYCLEANFILES += byteswap.h byteswap.h-t - -EXTRA_DIST += byteswap.in.h - -## end gnulib module byteswap - -## begin gnulib module c-ctype - -libgnu_a_SOURCES += c-ctype.h c-ctype.c - -## end gnulib module c-ctype - -## begin gnulib module c-strcase - -libgnu_a_SOURCES += c-strcase.h c-strcasecmp.c c-strncasecmp.c - -## end gnulib module c-strcase - -## begin gnulib module close-stream - -libgnu_a_SOURCES += close-stream.c - -EXTRA_DIST += close-stream.h - -## end gnulib module close-stream - -## begin gnulib module count-one-bits - -libgnu_a_SOURCES += count-one-bits.c - -EXTRA_DIST += count-one-bits.h - -## end gnulib module count-one-bits - -## begin gnulib module count-trailing-zeros - -libgnu_a_SOURCES += count-trailing-zeros.c - -EXTRA_DIST += count-trailing-zeros.h - -## end gnulib module count-trailing-zeros - -## begin gnulib module crypto/md5 - -libgnu_a_SOURCES += md5.c - -EXTRA_DIST += gl_openssl.h md5.h - -## end gnulib module crypto/md5 - -## begin gnulib module crypto/sha1 - -libgnu_a_SOURCES += sha1.c - -EXTRA_DIST += gl_openssl.h sha1.h - -## end gnulib module crypto/sha1 - -## begin gnulib module crypto/sha256 - -libgnu_a_SOURCES += sha256.c - -EXTRA_DIST += gl_openssl.h sha256.h - -## end gnulib module crypto/sha256 - -## begin gnulib module crypto/sha512 - -libgnu_a_SOURCES += sha512.c - -EXTRA_DIST += gl_openssl.h sha512.h - -## end gnulib module crypto/sha512 - -## begin gnulib module dosname - -if gl_GNULIB_ENABLED_dosname - -endif -EXTRA_DIST += dosname.h - -## end gnulib module dosname - -## begin gnulib module dtoastr - -libgnu_a_SOURCES += dtoastr.c - -EXTRA_DIST += ftoastr.c ftoastr.h - -EXTRA_libgnu_a_SOURCES += ftoastr.c - -## end gnulib module dtoastr - -## begin gnulib module dtotimespec - -libgnu_a_SOURCES += dtotimespec.c - -## end gnulib module dtotimespec - -## begin gnulib module dup2 - - -EXTRA_DIST += dup2.c - -EXTRA_libgnu_a_SOURCES += dup2.c - -## end gnulib module dup2 - -## begin gnulib module errno - -BUILT_SOURCES += $(ERRNO_H) - -# We need the following in order to create when the system -# doesn't have one that is POSIX compliant. -if GL_GENERATE_ERRNO_H -errno.h: errno.in.h $(top_builddir)/config.status - $(AM_V_GEN)rm -f $@-t $@ && \ - { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */' && \ - sed -e 's|@''GUARD_PREFIX''@|GL|g' \ - -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ - -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \ - -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \ - -e 's|@''NEXT_ERRNO_H''@|$(NEXT_ERRNO_H)|g' \ - -e 's|@''EMULTIHOP_HIDDEN''@|$(EMULTIHOP_HIDDEN)|g' \ - -e 's|@''EMULTIHOP_VALUE''@|$(EMULTIHOP_VALUE)|g' \ - -e 's|@''ENOLINK_HIDDEN''@|$(ENOLINK_HIDDEN)|g' \ - -e 's|@''ENOLINK_VALUE''@|$(ENOLINK_VALUE)|g' \ - -e 's|@''EOVERFLOW_HIDDEN''@|$(EOVERFLOW_HIDDEN)|g' \ - -e 's|@''EOVERFLOW_VALUE''@|$(EOVERFLOW_VALUE)|g' \ - < $(srcdir)/errno.in.h; \ - } > $@-t && \ - mv $@-t $@ -else -errno.h: $(top_builddir)/config.status - rm -f $@ -endif -MOSTLYCLEANFILES += errno.h errno.h-t - -EXTRA_DIST += errno.in.h - -## end gnulib module errno - -## begin gnulib module euidaccess - -if gl_GNULIB_ENABLED_euidaccess - -endif -EXTRA_DIST += euidaccess.c - -EXTRA_libgnu_a_SOURCES += euidaccess.c - -## end gnulib module euidaccess - -## begin gnulib module execinfo - -BUILT_SOURCES += $(EXECINFO_H) - -# We need the following in order to create when the system -# doesn't have one that works. -if GL_GENERATE_EXECINFO_H -execinfo.h: execinfo.in.h $(top_builddir)/config.status - $(AM_V_GEN)rm -f $@-t $@ && \ - { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \ - cat $(srcdir)/execinfo.in.h; \ - } > $@-t && \ - mv $@-t $@ -else -execinfo.h: $(top_builddir)/config.status - rm -f $@ -endif -MOSTLYCLEANFILES += execinfo.h execinfo.h-t - -EXTRA_DIST += execinfo.c execinfo.in.h - -EXTRA_libgnu_a_SOURCES += execinfo.c - -## end gnulib module execinfo - -## begin gnulib module faccessat - - -EXTRA_DIST += at-func.c faccessat.c - -EXTRA_libgnu_a_SOURCES += at-func.c faccessat.c - -## end gnulib module faccessat - -## begin gnulib module fdatasync - - -EXTRA_DIST += fdatasync.c - -EXTRA_libgnu_a_SOURCES += fdatasync.c - -## end gnulib module fdatasync - -## begin gnulib module fdopendir - - -EXTRA_DIST += fdopendir.c - -EXTRA_libgnu_a_SOURCES += fdopendir.c - -## end gnulib module fdopendir - -## begin gnulib module filemode - -libgnu_a_SOURCES += filemode.c - -EXTRA_DIST += filemode.h - -## end gnulib module filemode - -## begin gnulib module filevercmp - -libgnu_a_SOURCES += filevercmp.c - -EXTRA_DIST += filevercmp.h - -## end gnulib module filevercmp - -## begin gnulib module fpending - - -EXTRA_DIST += fpending.c fpending.h stdio-impl.h - -EXTRA_libgnu_a_SOURCES += fpending.c - -## end gnulib module fpending - -## begin gnulib module fstatat - - -EXTRA_DIST += at-func.c fstatat.c - -EXTRA_libgnu_a_SOURCES += at-func.c fstatat.c - -## end gnulib module fstatat - -## begin gnulib module fsync - - -EXTRA_DIST += fsync.c - -EXTRA_libgnu_a_SOURCES += fsync.c - -## end gnulib module fsync - -## begin gnulib module getdtablesize - -if gl_GNULIB_ENABLED_getdtablesize - -endif -EXTRA_DIST += getdtablesize.c - -EXTRA_libgnu_a_SOURCES += getdtablesize.c - -## end gnulib module getdtablesize - -## begin gnulib module getgroups - -if gl_GNULIB_ENABLED_getgroups - -endif -EXTRA_DIST += getgroups.c - -EXTRA_libgnu_a_SOURCES += getgroups.c - -## end gnulib module getgroups - -## begin gnulib module getloadavg - - -EXTRA_DIST += getloadavg.c - -EXTRA_libgnu_a_SOURCES += getloadavg.c - -## end gnulib module getloadavg - -## begin gnulib module getopt-posix - -BUILT_SOURCES += $(GETOPT_H) - -# We need the following in order to create when the system -# doesn't have one that works with the given compiler. -getopt.h: getopt.in.h $(top_builddir)/config.status $(ARG_NONNULL_H) - $(AM_V_GEN)rm -f $@-t $@ && \ - { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \ - sed -e 's|@''GUARD_PREFIX''@|GL|g' \ - -e 's|@''HAVE_GETOPT_H''@|$(HAVE_GETOPT_H)|g' \ - -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ - -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \ - -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \ - -e 's|@''NEXT_GETOPT_H''@|$(NEXT_GETOPT_H)|g' \ - -e '/definition of _GL_ARG_NONNULL/r $(ARG_NONNULL_H)' \ - < $(srcdir)/getopt.in.h; \ - } > $@-t && \ - mv -f $@-t $@ -MOSTLYCLEANFILES += getopt.h getopt.h-t - -EXTRA_DIST += getopt.c getopt.in.h getopt1.c getopt_int.h - -EXTRA_libgnu_a_SOURCES += getopt.c getopt1.c - -## end gnulib module getopt-posix - -## begin gnulib module gettext-h - -if gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36 -libgnu_a_SOURCES += gettext.h - -endif -## end gnulib module gettext-h - -## begin gnulib module gettime - -libgnu_a_SOURCES += gettime.c - -## end gnulib module gettime - -## begin gnulib module gettimeofday - - -EXTRA_DIST += gettimeofday.c - -EXTRA_libgnu_a_SOURCES += gettimeofday.c - -## end gnulib module gettimeofday - -## begin gnulib module group-member - -if gl_GNULIB_ENABLED_a9786850e999ae65a836a6041e8e5ed1 - -endif -EXTRA_DIST += group-member.c - -EXTRA_libgnu_a_SOURCES += group-member.c - -## end gnulib module group-member - -## begin gnulib module ignore-value - - -EXTRA_DIST += ignore-value.h - -## end gnulib module ignore-value - -## begin gnulib module intprops - - -EXTRA_DIST += intprops.h - -## end gnulib module intprops - -## begin gnulib module limits-h - -BUILT_SOURCES += $(LIMITS_H) - -# We need the following in order to create when the system -# doesn't have one that is compatible with GNU. -if GL_GENERATE_LIMITS_H -limits.h: limits.in.h $(top_builddir)/config.status - $(AM_V_GEN)rm -f $@-t $@ && \ - { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */' && \ - sed -e 's|@''GUARD_PREFIX''@|GL|g' \ - -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ - -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \ - -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \ - -e 's|@''NEXT_LIMITS_H''@|$(NEXT_LIMITS_H)|g' \ - < $(srcdir)/limits.in.h; \ - } > $@-t && \ - mv $@-t $@ -else -limits.h: $(top_builddir)/config.status - rm -f $@ -endif -MOSTLYCLEANFILES += limits.h limits.h-t - -EXTRA_DIST += limits.in.h - -## end gnulib module limits-h - -## begin gnulib module lstat - - -EXTRA_DIST += lstat.c - -EXTRA_libgnu_a_SOURCES += lstat.c - -## end gnulib module lstat - -## begin gnulib module memrchr - - -EXTRA_DIST += memrchr.c - -EXTRA_libgnu_a_SOURCES += memrchr.c - -## end gnulib module memrchr - -## begin gnulib module mktime - - -EXTRA_DIST += mktime-internal.h mktime.c - -EXTRA_libgnu_a_SOURCES += mktime.c - -## end gnulib module mktime - -## begin gnulib module mktime-internal - -if gl_GNULIB_ENABLED_5264294aa0a5557541b53c8c741f7f31 - -endif -EXTRA_DIST += mktime-internal.h mktime.c - -EXTRA_libgnu_a_SOURCES += mktime.c - -## end gnulib module mktime-internal - -## begin gnulib module openat-h - -if gl_GNULIB_ENABLED_03e0aaad4cb89ca757653bd367a6ccb7 - -endif -EXTRA_DIST += openat.h - -## end gnulib module openat-h - -## begin gnulib module pathmax - -if gl_GNULIB_ENABLED_pathmax - -endif -EXTRA_DIST += pathmax.h - -## end gnulib module pathmax - -## begin gnulib module pselect - - -EXTRA_DIST += pselect.c - -EXTRA_libgnu_a_SOURCES += pselect.c - -## end gnulib module pselect - -## begin gnulib module pthread_sigmask - - -EXTRA_DIST += pthread_sigmask.c - -EXTRA_libgnu_a_SOURCES += pthread_sigmask.c - -## end gnulib module pthread_sigmask - -## begin gnulib module putenv - - -EXTRA_DIST += putenv.c - -EXTRA_libgnu_a_SOURCES += putenv.c - -## end gnulib module putenv - -## begin gnulib module qcopy-acl - -libgnu_a_SOURCES += qcopy-acl.c - -## end gnulib module qcopy-acl - -## begin gnulib module readlink - - -EXTRA_DIST += readlink.c - -EXTRA_libgnu_a_SOURCES += readlink.c - -## end gnulib module readlink - -## begin gnulib module readlinkat - - -EXTRA_DIST += at-func.c readlinkat.c - -EXTRA_libgnu_a_SOURCES += at-func.c readlinkat.c - -## end gnulib module readlinkat - -## begin gnulib module root-uid - -if gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c - -endif -EXTRA_DIST += root-uid.h - -## end gnulib module root-uid - -## begin gnulib module sig2str - - -EXTRA_DIST += sig2str.c sig2str.h - -EXTRA_libgnu_a_SOURCES += sig2str.c - -## end gnulib module sig2str - -## begin gnulib module snippet/_Noreturn - -# Because this Makefile snippet defines a variable used by other -# gnulib Makefile snippets, it must be present in all Makefile.am that -# need it. This is ensured by the applicability 'all' defined above. - -_NORETURN_H=$(top_srcdir)/build-aux/snippet/_Noreturn.h - -EXTRA_DIST += $(top_srcdir)/build-aux/snippet/_Noreturn.h - -## end gnulib module snippet/_Noreturn - -## begin gnulib module snippet/arg-nonnull - -# The BUILT_SOURCES created by this Makefile snippet are not used via #include -# statements but through direct file reference. Therefore this snippet must be -# present in all Makefile.am that need it. This is ensured by the applicability -# 'all' defined above. - -BUILT_SOURCES += arg-nonnull.h -# The arg-nonnull.h that gets inserted into generated .h files is the same as -# build-aux/snippet/arg-nonnull.h, except that it has the copyright header cut -# off. -arg-nonnull.h: $(top_srcdir)/build-aux/snippet/arg-nonnull.h - $(AM_V_GEN)rm -f $@-t $@ && \ - sed -n -e '/GL_ARG_NONNULL/,$$p' \ - < $(top_srcdir)/build-aux/snippet/arg-nonnull.h \ - > $@-t && \ - mv $@-t $@ -MOSTLYCLEANFILES += arg-nonnull.h arg-nonnull.h-t - -ARG_NONNULL_H=arg-nonnull.h - -EXTRA_DIST += $(top_srcdir)/build-aux/snippet/arg-nonnull.h - -## end gnulib module snippet/arg-nonnull - -## begin gnulib module snippet/c++defs - -# The BUILT_SOURCES created by this Makefile snippet are not used via #include -# statements but through direct file reference. Therefore this snippet must be -# present in all Makefile.am that need it. This is ensured by the applicability -# 'all' defined above. - -BUILT_SOURCES += c++defs.h -# The c++defs.h that gets inserted into generated .h files is the same as -# build-aux/snippet/c++defs.h, except that it has the copyright header cut off. -c++defs.h: $(top_srcdir)/build-aux/snippet/c++defs.h - $(AM_V_GEN)rm -f $@-t $@ && \ - sed -n -e '/_GL_CXXDEFS/,$$p' \ - < $(top_srcdir)/build-aux/snippet/c++defs.h \ - > $@-t && \ - mv $@-t $@ -MOSTLYCLEANFILES += c++defs.h c++defs.h-t - -CXXDEFS_H=c++defs.h - -EXTRA_DIST += $(top_srcdir)/build-aux/snippet/c++defs.h - -## end gnulib module snippet/c++defs - -## begin gnulib module snippet/warn-on-use - -BUILT_SOURCES += warn-on-use.h -# The warn-on-use.h that gets inserted into generated .h files is the same as -# build-aux/snippet/warn-on-use.h, except that it has the copyright header cut -# off. -warn-on-use.h: $(top_srcdir)/build-aux/snippet/warn-on-use.h - $(AM_V_GEN)rm -f $@-t $@ && \ - sed -n -e '/^.ifndef/,$$p' \ - < $(top_srcdir)/build-aux/snippet/warn-on-use.h \ - > $@-t && \ - mv $@-t $@ -MOSTLYCLEANFILES += warn-on-use.h warn-on-use.h-t - -WARN_ON_USE_H=warn-on-use.h - -EXTRA_DIST += $(top_srcdir)/build-aux/snippet/warn-on-use.h - -## end gnulib module snippet/warn-on-use - -## begin gnulib module stat - -if gl_GNULIB_ENABLED_stat - -endif -EXTRA_DIST += stat.c - -EXTRA_libgnu_a_SOURCES += stat.c - -## end gnulib module stat - -## begin gnulib module stat-time - -libgnu_a_SOURCES += stat-time.c - -EXTRA_DIST += stat-time.h - -## end gnulib module stat-time - -## begin gnulib module stdalign - -BUILT_SOURCES += $(STDALIGN_H) - -# We need the following in order to create when the system -# doesn't have one that works. -if GL_GENERATE_STDALIGN_H -stdalign.h: stdalign.in.h $(top_builddir)/config.status - $(AM_V_GEN)rm -f $@-t $@ && \ - { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \ - cat $(srcdir)/stdalign.in.h; \ - } > $@-t && \ - mv $@-t $@ -else -stdalign.h: $(top_builddir)/config.status - rm -f $@ -endif -MOSTLYCLEANFILES += stdalign.h stdalign.h-t - -EXTRA_DIST += stdalign.in.h - -## end gnulib module stdalign - -## begin gnulib module stddef - -BUILT_SOURCES += $(STDDEF_H) - -# We need the following in order to create when the system -# doesn't have one that works with the given compiler. -if GL_GENERATE_STDDEF_H -stddef.h: stddef.in.h $(top_builddir)/config.status - $(AM_V_GEN)rm -f $@-t $@ && \ - { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */' && \ - sed -e 's|@''GUARD_PREFIX''@|GL|g' \ - -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ - -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \ - -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \ - -e 's|@''NEXT_STDDEF_H''@|$(NEXT_STDDEF_H)|g' \ - -e 's|@''HAVE_MAX_ALIGN_T''@|$(HAVE_MAX_ALIGN_T)|g' \ - -e 's|@''HAVE_WCHAR_T''@|$(HAVE_WCHAR_T)|g' \ - -e 's|@''REPLACE_NULL''@|$(REPLACE_NULL)|g' \ - < $(srcdir)/stddef.in.h; \ - } > $@-t && \ - mv $@-t $@ -else -stddef.h: $(top_builddir)/config.status - rm -f $@ -endif -MOSTLYCLEANFILES += stddef.h stddef.h-t - -EXTRA_DIST += stddef.in.h - -## end gnulib module stddef - -## begin gnulib module stdint - -BUILT_SOURCES += $(STDINT_H) - -# We need the following in order to create when the system -# doesn't have one that works with the given compiler. -if GL_GENERATE_STDINT_H -stdint.h: stdint.in.h $(top_builddir)/config.status - $(AM_V_GEN)rm -f $@-t $@ && \ - { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \ - sed -e 's|@''GUARD_PREFIX''@|GL|g' \ - -e 's/@''HAVE_STDINT_H''@/$(HAVE_STDINT_H)/g' \ - -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ - -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \ - -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \ - -e 's|@''NEXT_STDINT_H''@|$(NEXT_STDINT_H)|g' \ - -e 's/@''HAVE_C99_STDINT_H''@/$(HAVE_C99_STDINT_H)/g' \ - -e 's/@''HAVE_SYS_TYPES_H''@/$(HAVE_SYS_TYPES_H)/g' \ - -e 's/@''HAVE_INTTYPES_H''@/$(HAVE_INTTYPES_H)/g' \ - -e 's/@''HAVE_SYS_INTTYPES_H''@/$(HAVE_SYS_INTTYPES_H)/g' \ - -e 's/@''HAVE_SYS_BITYPES_H''@/$(HAVE_SYS_BITYPES_H)/g' \ - -e 's/@''HAVE_WCHAR_H''@/$(HAVE_WCHAR_H)/g' \ - -e 's/@''HAVE_LONG_LONG_INT''@/$(HAVE_LONG_LONG_INT)/g' \ - -e 's/@''HAVE_UNSIGNED_LONG_LONG_INT''@/$(HAVE_UNSIGNED_LONG_LONG_INT)/g' \ - -e 's/@''APPLE_UNIVERSAL_BUILD''@/$(APPLE_UNIVERSAL_BUILD)/g' \ - -e 's/@''BITSIZEOF_PTRDIFF_T''@/$(BITSIZEOF_PTRDIFF_T)/g' \ - -e 's/@''PTRDIFF_T_SUFFIX''@/$(PTRDIFF_T_SUFFIX)/g' \ - -e 's/@''BITSIZEOF_SIG_ATOMIC_T''@/$(BITSIZEOF_SIG_ATOMIC_T)/g' \ - -e 's/@''HAVE_SIGNED_SIG_ATOMIC_T''@/$(HAVE_SIGNED_SIG_ATOMIC_T)/g' \ - -e 's/@''SIG_ATOMIC_T_SUFFIX''@/$(SIG_ATOMIC_T_SUFFIX)/g' \ - -e 's/@''BITSIZEOF_SIZE_T''@/$(BITSIZEOF_SIZE_T)/g' \ - -e 's/@''SIZE_T_SUFFIX''@/$(SIZE_T_SUFFIX)/g' \ - -e 's/@''BITSIZEOF_WCHAR_T''@/$(BITSIZEOF_WCHAR_T)/g' \ - -e 's/@''HAVE_SIGNED_WCHAR_T''@/$(HAVE_SIGNED_WCHAR_T)/g' \ - -e 's/@''WCHAR_T_SUFFIX''@/$(WCHAR_T_SUFFIX)/g' \ - -e 's/@''BITSIZEOF_WINT_T''@/$(BITSIZEOF_WINT_T)/g' \ - -e 's/@''HAVE_SIGNED_WINT_T''@/$(HAVE_SIGNED_WINT_T)/g' \ - -e 's/@''WINT_T_SUFFIX''@/$(WINT_T_SUFFIX)/g' \ - -e 's/@''GNULIB_OVERRIDES_WINT_T''@/$(GNULIB_OVERRIDES_WINT_T)/g' \ - < $(srcdir)/stdint.in.h; \ - } > $@-t && \ - mv $@-t $@ -else -stdint.h: $(top_builddir)/config.status - rm -f $@ -endif -MOSTLYCLEANFILES += stdint.h stdint.h-t - -EXTRA_DIST += stdint.in.h - -## end gnulib module stdint - -## begin gnulib module stpcpy - - -EXTRA_DIST += stpcpy.c - -EXTRA_libgnu_a_SOURCES += stpcpy.c - -## end gnulib module stpcpy - -## begin gnulib module strftime - -libgnu_a_SOURCES += strftime.c - -EXTRA_DIST += strftime.h - -## end gnulib module strftime - -## begin gnulib module string - -BUILT_SOURCES += string.h - -# We need the following in order to create when the system -# doesn't have one that works with the given compiler. -string.h: string.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H) $(WARN_ON_USE_H) - $(AM_V_GEN)rm -f $@-t $@ && \ - { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */' && \ - sed -e 's|@''GUARD_PREFIX''@|GL|g' \ - -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ - -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \ - -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \ - -e 's|@''NEXT_STRING_H''@|$(NEXT_STRING_H)|g' \ - -e 's/@''GNULIB_FFSL''@/$(GNULIB_FFSL)/g' \ - -e 's/@''GNULIB_FFSLL''@/$(GNULIB_FFSLL)/g' \ - -e 's/@''GNULIB_MBSLEN''@/$(GNULIB_MBSLEN)/g' \ - -e 's/@''GNULIB_MBSNLEN''@/$(GNULIB_MBSNLEN)/g' \ - -e 's/@''GNULIB_MBSCHR''@/$(GNULIB_MBSCHR)/g' \ - -e 's/@''GNULIB_MBSRCHR''@/$(GNULIB_MBSRCHR)/g' \ - -e 's/@''GNULIB_MBSSTR''@/$(GNULIB_MBSSTR)/g' \ - -e 's/@''GNULIB_MBSCASECMP''@/$(GNULIB_MBSCASECMP)/g' \ - -e 's/@''GNULIB_MBSNCASECMP''@/$(GNULIB_MBSNCASECMP)/g' \ - -e 's/@''GNULIB_MBSPCASECMP''@/$(GNULIB_MBSPCASECMP)/g' \ - -e 's/@''GNULIB_MBSCASESTR''@/$(GNULIB_MBSCASESTR)/g' \ - -e 's/@''GNULIB_MBSCSPN''@/$(GNULIB_MBSCSPN)/g' \ - -e 's/@''GNULIB_MBSPBRK''@/$(GNULIB_MBSPBRK)/g' \ - -e 's/@''GNULIB_MBSSPN''@/$(GNULIB_MBSSPN)/g' \ - -e 's/@''GNULIB_MBSSEP''@/$(GNULIB_MBSSEP)/g' \ - -e 's/@''GNULIB_MBSTOK_R''@/$(GNULIB_MBSTOK_R)/g' \ - -e 's/@''GNULIB_MEMCHR''@/$(GNULIB_MEMCHR)/g' \ - -e 's/@''GNULIB_MEMMEM''@/$(GNULIB_MEMMEM)/g' \ - -e 's/@''GNULIB_MEMPCPY''@/$(GNULIB_MEMPCPY)/g' \ - -e 's/@''GNULIB_MEMRCHR''@/$(GNULIB_MEMRCHR)/g' \ - -e 's/@''GNULIB_RAWMEMCHR''@/$(GNULIB_RAWMEMCHR)/g' \ - -e 's/@''GNULIB_STPCPY''@/$(GNULIB_STPCPY)/g' \ - -e 's/@''GNULIB_STPNCPY''@/$(GNULIB_STPNCPY)/g' \ - -e 's/@''GNULIB_STRCHRNUL''@/$(GNULIB_STRCHRNUL)/g' \ - -e 's/@''GNULIB_STRDUP''@/$(GNULIB_STRDUP)/g' \ - -e 's/@''GNULIB_STRNCAT''@/$(GNULIB_STRNCAT)/g' \ - -e 's/@''GNULIB_STRNDUP''@/$(GNULIB_STRNDUP)/g' \ - -e 's/@''GNULIB_STRNLEN''@/$(GNULIB_STRNLEN)/g' \ - -e 's/@''GNULIB_STRPBRK''@/$(GNULIB_STRPBRK)/g' \ - -e 's/@''GNULIB_STRSEP''@/$(GNULIB_STRSEP)/g' \ - -e 's/@''GNULIB_STRSTR''@/$(GNULIB_STRSTR)/g' \ - -e 's/@''GNULIB_STRCASESTR''@/$(GNULIB_STRCASESTR)/g' \ - -e 's/@''GNULIB_STRTOK_R''@/$(GNULIB_STRTOK_R)/g' \ - -e 's/@''GNULIB_STRERROR''@/$(GNULIB_STRERROR)/g' \ - -e 's/@''GNULIB_STRERROR_R''@/$(GNULIB_STRERROR_R)/g' \ - -e 's/@''GNULIB_STRSIGNAL''@/$(GNULIB_STRSIGNAL)/g' \ - -e 's/@''GNULIB_STRVERSCMP''@/$(GNULIB_STRVERSCMP)/g' \ - < $(srcdir)/string.in.h | \ - sed -e 's|@''HAVE_FFSL''@|$(HAVE_FFSL)|g' \ - -e 's|@''HAVE_FFSLL''@|$(HAVE_FFSLL)|g' \ - -e 's|@''HAVE_MBSLEN''@|$(HAVE_MBSLEN)|g' \ - -e 's|@''HAVE_MEMCHR''@|$(HAVE_MEMCHR)|g' \ - -e 's|@''HAVE_DECL_MEMMEM''@|$(HAVE_DECL_MEMMEM)|g' \ - -e 's|@''HAVE_MEMPCPY''@|$(HAVE_MEMPCPY)|g' \ - -e 's|@''HAVE_DECL_MEMRCHR''@|$(HAVE_DECL_MEMRCHR)|g' \ - -e 's|@''HAVE_RAWMEMCHR''@|$(HAVE_RAWMEMCHR)|g' \ - -e 's|@''HAVE_STPCPY''@|$(HAVE_STPCPY)|g' \ - -e 's|@''HAVE_STPNCPY''@|$(HAVE_STPNCPY)|g' \ - -e 's|@''HAVE_STRCHRNUL''@|$(HAVE_STRCHRNUL)|g' \ - -e 's|@''HAVE_DECL_STRDUP''@|$(HAVE_DECL_STRDUP)|g' \ - -e 's|@''HAVE_DECL_STRNDUP''@|$(HAVE_DECL_STRNDUP)|g' \ - -e 's|@''HAVE_DECL_STRNLEN''@|$(HAVE_DECL_STRNLEN)|g' \ - -e 's|@''HAVE_STRPBRK''@|$(HAVE_STRPBRK)|g' \ - -e 's|@''HAVE_STRSEP''@|$(HAVE_STRSEP)|g' \ - -e 's|@''HAVE_STRCASESTR''@|$(HAVE_STRCASESTR)|g' \ - -e 's|@''HAVE_DECL_STRTOK_R''@|$(HAVE_DECL_STRTOK_R)|g' \ - -e 's|@''HAVE_DECL_STRERROR_R''@|$(HAVE_DECL_STRERROR_R)|g' \ - -e 's|@''HAVE_DECL_STRSIGNAL''@|$(HAVE_DECL_STRSIGNAL)|g' \ - -e 's|@''HAVE_STRVERSCMP''@|$(HAVE_STRVERSCMP)|g' \ - -e 's|@''REPLACE_STPNCPY''@|$(REPLACE_STPNCPY)|g' \ - -e 's|@''REPLACE_MEMCHR''@|$(REPLACE_MEMCHR)|g' \ - -e 's|@''REPLACE_MEMMEM''@|$(REPLACE_MEMMEM)|g' \ - -e 's|@''REPLACE_STRCASESTR''@|$(REPLACE_STRCASESTR)|g' \ - -e 's|@''REPLACE_STRCHRNUL''@|$(REPLACE_STRCHRNUL)|g' \ - -e 's|@''REPLACE_STRDUP''@|$(REPLACE_STRDUP)|g' \ - -e 's|@''REPLACE_STRSTR''@|$(REPLACE_STRSTR)|g' \ - -e 's|@''REPLACE_STRERROR''@|$(REPLACE_STRERROR)|g' \ - -e 's|@''REPLACE_STRERROR_R''@|$(REPLACE_STRERROR_R)|g' \ - -e 's|@''REPLACE_STRNCAT''@|$(REPLACE_STRNCAT)|g' \ - -e 's|@''REPLACE_STRNDUP''@|$(REPLACE_STRNDUP)|g' \ - -e 's|@''REPLACE_STRNLEN''@|$(REPLACE_STRNLEN)|g' \ - -e 's|@''REPLACE_STRSIGNAL''@|$(REPLACE_STRSIGNAL)|g' \ - -e 's|@''REPLACE_STRTOK_R''@|$(REPLACE_STRTOK_R)|g' \ - -e 's|@''UNDEFINE_STRTOK_R''@|$(UNDEFINE_STRTOK_R)|g' \ - -e '/definitions of _GL_FUNCDECL_RPL/r $(CXXDEFS_H)' \ - -e '/definition of _GL_ARG_NONNULL/r $(ARG_NONNULL_H)' \ - -e '/definition of _GL_WARN_ON_USE/r $(WARN_ON_USE_H)'; \ - < $(srcdir)/string.in.h; \ - } > $@-t && \ - mv $@-t $@ -MOSTLYCLEANFILES += string.h string.h-t - -EXTRA_DIST += string.in.h - -## end gnulib module string - -## begin gnulib module strtoimax - - -EXTRA_DIST += strtoimax.c - -EXTRA_libgnu_a_SOURCES += strtoimax.c - -## end gnulib module strtoimax - -## begin gnulib module strtoll - -if gl_GNULIB_ENABLED_strtoll - -endif -EXTRA_DIST += strtol.c strtoll.c - -EXTRA_libgnu_a_SOURCES += strtol.c strtoll.c - -## end gnulib module strtoll - -## begin gnulib module strtoull - -if gl_GNULIB_ENABLED_strtoull - -endif -EXTRA_DIST += strtol.c strtoul.c strtoull.c - -EXTRA_libgnu_a_SOURCES += strtol.c strtoul.c strtoull.c - -## end gnulib module strtoull - -## begin gnulib module strtoumax - - -EXTRA_DIST += strtoimax.c strtoumax.c - -EXTRA_libgnu_a_SOURCES += strtoimax.c strtoumax.c - -## end gnulib module strtoumax - -## begin gnulib module symlink - - -EXTRA_DIST += symlink.c - -EXTRA_libgnu_a_SOURCES += symlink.c - -## end gnulib module symlink - -## begin gnulib module time - -BUILT_SOURCES += time.h - -# We need the following in order to create when the system -# doesn't have one that works with the given compiler. -time.h: time.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H) $(WARN_ON_USE_H) - $(AM_V_GEN)rm -f $@-t $@ && \ - { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */' && \ - sed -e 's|@''GUARD_PREFIX''@|GL|g' \ - -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ - -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \ - -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \ - -e 's|@''NEXT_TIME_H''@|$(NEXT_TIME_H)|g' \ - -e 's/@''GNULIB_GETTIMEOFDAY''@/$(GNULIB_GETTIMEOFDAY)/g' \ - -e 's/@''GNULIB_MKTIME''@/$(GNULIB_MKTIME)/g' \ - -e 's/@''GNULIB_NANOSLEEP''@/$(GNULIB_NANOSLEEP)/g' \ - -e 's/@''GNULIB_STRPTIME''@/$(GNULIB_STRPTIME)/g' \ - -e 's/@''GNULIB_TIMEGM''@/$(GNULIB_TIMEGM)/g' \ - -e 's/@''GNULIB_TIME_R''@/$(GNULIB_TIME_R)/g' \ - -e 's/@''GNULIB_TIME_RZ''@/$(GNULIB_TIME_RZ)/g' \ - -e 's|@''HAVE_DECL_LOCALTIME_R''@|$(HAVE_DECL_LOCALTIME_R)|g' \ - -e 's|@''HAVE_NANOSLEEP''@|$(HAVE_NANOSLEEP)|g' \ - -e 's|@''HAVE_STRPTIME''@|$(HAVE_STRPTIME)|g' \ - -e 's|@''HAVE_TIMEGM''@|$(HAVE_TIMEGM)|g' \ - -e 's|@''HAVE_TIMEZONE_T''@|$(HAVE_TIMEZONE_T)|g' \ - -e 's|@''REPLACE_GMTIME''@|$(REPLACE_GMTIME)|g' \ - -e 's|@''REPLACE_LOCALTIME''@|$(REPLACE_LOCALTIME)|g' \ - -e 's|@''REPLACE_LOCALTIME_R''@|$(REPLACE_LOCALTIME_R)|g' \ - -e 's|@''REPLACE_MKTIME''@|$(REPLACE_MKTIME)|g' \ - -e 's|@''REPLACE_NANOSLEEP''@|$(REPLACE_NANOSLEEP)|g' \ - -e 's|@''REPLACE_TIMEGM''@|$(REPLACE_TIMEGM)|g' \ - -e 's|@''PTHREAD_H_DEFINES_STRUCT_TIMESPEC''@|$(PTHREAD_H_DEFINES_STRUCT_TIMESPEC)|g' \ - -e 's|@''SYS_TIME_H_DEFINES_STRUCT_TIMESPEC''@|$(SYS_TIME_H_DEFINES_STRUCT_TIMESPEC)|g' \ - -e 's|@''TIME_H_DEFINES_STRUCT_TIMESPEC''@|$(TIME_H_DEFINES_STRUCT_TIMESPEC)|g' \ - -e 's|@''UNISTD_H_DEFINES_STRUCT_TIMESPEC''@|$(UNISTD_H_DEFINES_STRUCT_TIMESPEC)|g' \ - -e '/definitions of _GL_FUNCDECL_RPL/r $(CXXDEFS_H)' \ - -e '/definition of _GL_ARG_NONNULL/r $(ARG_NONNULL_H)' \ - -e '/definition of _GL_WARN_ON_USE/r $(WARN_ON_USE_H)' \ - < $(srcdir)/time.in.h; \ - } > $@-t && \ - mv $@-t $@ -MOSTLYCLEANFILES += time.h time.h-t - -EXTRA_DIST += time.in.h - -## end gnulib module time - -## begin gnulib module time_r - - -EXTRA_DIST += time_r.c - -EXTRA_libgnu_a_SOURCES += time_r.c - -## end gnulib module time_r - -## begin gnulib module time_rz - - -EXTRA_DIST += time_rz.c - -EXTRA_libgnu_a_SOURCES += time_rz.c - -## end gnulib module time_rz - -## begin gnulib module timegm - - -EXTRA_DIST += mktime-internal.h timegm.c - -EXTRA_libgnu_a_SOURCES += timegm.c - -## end gnulib module timegm - -## begin gnulib module timespec - -libgnu_a_SOURCES += timespec.c - -EXTRA_DIST += timespec.h - -## end gnulib module timespec - -## begin gnulib module timespec-add - -libgnu_a_SOURCES += timespec-add.c - -## end gnulib module timespec-add - -## begin gnulib module timespec-sub - -libgnu_a_SOURCES += timespec-sub.c - -## end gnulib module timespec-sub - -## begin gnulib module u64 - -libgnu_a_SOURCES += u64.c - -EXTRA_DIST += u64.h - -## end gnulib module u64 - -## begin gnulib module update-copyright - - -EXTRA_DIST += $(top_srcdir)/build-aux/update-copyright - -## end gnulib module update-copyright - -## begin gnulib module utimens - -libgnu_a_SOURCES += utimens.c - -EXTRA_DIST += utimens.h - -## end gnulib module utimens - -## begin gnulib module verify - - -EXTRA_DIST += verify.h - -## end gnulib module verify - -## begin gnulib module vla - - -EXTRA_DIST += vla.h - -## end gnulib module vla - -## begin gnulib module xalloc-oversized - -if gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec - -endif -EXTRA_DIST += xalloc-oversized.h - -## end gnulib module xalloc-oversized - - -mostlyclean-local: mostlyclean-generic - @for dir in '' $(MOSTLYCLEANDIRS); do \ - if test -n "$$dir" && test -d $$dir; then \ - echo "rmdir $$dir"; rmdir $$dir; \ - fi; \ - done; \ - : diff --git a/src/w32.c b/src/w32.c index 30aced9d9f..f35ad67d82 100644 --- a/src/w32.c +++ b/src/w32.c @@ -6407,6 +6407,23 @@ acl_set_file (const char *fname, acl_type_t type, acl_t acl) return retval; } +/* Return true if errno value ERRNUM indicates that ACLs are well + supported on this system. ERRNUM should be an errno value obtained + after an ACL-related system call fails. */ +bool +acl_errno_valid (int errnum) +{ + switch (errnum) + { + case EBUSY: + case EINVAL: + case ENOTSUP: + return false; + default: + return true; + } +} + /* MS-Windows version of careadlinkat (cf. ../lib/careadlinkat.c). We have a fixed max size for file names, so we don't need the kind of commit 134e86b360cab0d0a5cb634b71a4b06ec26c5f1f Author: Noam Postavsky Date: Wed Dec 28 20:13:20 2016 -0500 Handle multibyte chars spanning chunks in term.el * lisp/term.el (term-terminal-undecoded-bytes): New variable. (term-mode): Make it buffer local. Don't make `term-terminal-parameter' buffer-local twice. (term-emulate-terminal): Check for bytes of incompletely decoded characters, and save them until the next call when they can be fully decoded (Bug#25288). diff --git a/lisp/term.el b/lisp/term.el index e624f7dcd9..a3933ae4a4 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -341,6 +341,7 @@ (defconst term-protocol-version "0.96") (eval-when-compile (require 'ange-ftp)) +(eval-when-compile (require 'cl-lib)) (require 'ring) (require 'ehelp) @@ -404,6 +405,7 @@ state 4: term-terminal-parameter contains pending output.") (defvar term-kill-echo-list nil "A queue of strings whose echo we want suppressed.") (defvar term-terminal-parameter) +(defvar term-terminal-undecoded-bytes nil) (defvar term-terminal-previous-parameter) (defvar term-current-face 'term) (defvar term-scroll-start 0 "Top-most line (inclusive) of scrolling region.") @@ -1015,7 +1017,6 @@ Entry to this mode runs the hooks on `term-mode-hook'." ;; These local variables are set to their local values: (make-local-variable 'term-saved-home-marker) - (make-local-variable 'term-terminal-parameter) (make-local-variable 'term-saved-cursor) (make-local-variable 'term-prompt-regexp) (make-local-variable 'term-input-ring-size) @@ -1052,6 +1053,7 @@ Entry to this mode runs the hooks on `term-mode-hook'." (make-local-variable 'term-ansi-current-invisible) (make-local-variable 'term-terminal-parameter) + (make-local-variable 'term-terminal-undecoded-bytes) (make-local-variable 'term-terminal-previous-parameter) (make-local-variable 'term-terminal-previous-parameter-2) (make-local-variable 'term-terminal-previous-parameter-3) @@ -2748,6 +2750,10 @@ See `term-prompt-regexp'." (when term-log-buffer (princ str term-log-buffer)) + (when term-terminal-undecoded-bytes + (setq str (concat term-terminal-undecoded-bytes str)) + (setq str-length (length str)) + (setq term-terminal-undecoded-bytes nil)) (cond ((eq term-terminal-state 4) ;; Have saved pending output. (setq str (concat term-terminal-parameter str)) (setq term-terminal-parameter nil) @@ -2763,13 +2769,6 @@ See `term-prompt-regexp'." str i)) (when (not funny) (setq funny str-length)) (cond ((> funny i) - ;; Decode the string before counting - ;; characters, to avoid garbling of certain - ;; multibyte characters (bug#1006). - (setq decoded-substring - (decode-coding-string - (substring str i funny) - locale-coding-system)) (cond ((eq term-terminal-state 1) ;; We are in state 1, we need to wrap ;; around. Go to the beginning of @@ -2778,7 +2777,31 @@ See `term-prompt-regexp'." (term-down 1 t) (term-move-columns (- (term-current-column))) (setq term-terminal-state 0))) + ;; Decode the string before counting + ;; characters, to avoid garbling of certain + ;; multibyte characters (bug#1006). + (setq decoded-substring + (decode-coding-string + (substring str i funny) + locale-coding-system)) (setq count (length decoded-substring)) + ;; Check for multibyte characters that ends + ;; before end of string, and save it for + ;; next time. + (when (= funny str-length) + (let ((partial 0)) + (while (eq (char-charset (aref decoded-substring + (- count 1 partial))) + 'eight-bit) + (cl-incf partial)) + (when (> partial 0) + (setq term-terminal-undecoded-bytes + (substring decoded-substring (- partial))) + (setq decoded-substring + (substring decoded-substring 0 (- partial))) + (cl-decf str-length partial) + (cl-decf count partial) + (cl-decf funny partial)))) (setq temp (- (+ (term-horizontal-column) count) term-width)) (cond ((or term-suppress-hard-newline (<= temp 0))) commit 975b2acfe6a4e246631c372063d7bdef0f832d3d Author: Michael Albinus Date: Tue Jan 3 09:50:41 2017 +0100 Finish work on filenotify-tests.el * test/lisp/filenotify-tests.el (file-notify--test-monitors): New variable. (file-notify--test-cleanup, file-notify--test-monitor): Use it. (file-notify--test-read-event, file-notify-test02-events) (file-notify-test04-file-validity): Handle "gvfs-monitor-dir.exe". (file-notify-test03-autorevert) (file-notify-test08-watched-file-in-watched-dir): Set `file-notify--test-desc' for proper work of `file-notify--test-monitor'. (Bug#21804) diff --git a/test/lisp/filenotify-tests.el b/test/lisp/filenotify-tests.el index 2c085b34de..d237d0cc06 100644 --- a/test/lisp/filenotify-tests.el +++ b/test/lisp/filenotify-tests.el @@ -63,6 +63,7 @@ (defvar file-notify--test-results nil) (defvar file-notify--test-event nil) (defvar file-notify--test-events nil) +(defvar file-notify--test-monitors nil) (defun file-notify--test-read-event () "Read one event. @@ -78,6 +79,7 @@ There are different timeouts for local and remote file notification libraries." (memq (file-notify--test-monitor) '(GFamFileMonitor GPollFileMonitor))) 7) + ((string-equal (file-notify--test-library) "gvfs-monitor-dir.exe") 1) ((file-remote-p temporary-file-directory) 0.1) (t 0.01)))) @@ -153,7 +155,8 @@ Return nil when any other file notification watch is still active." file-notify--test-desc1 nil file-notify--test-desc2 nil file-notify--test-results nil - file-notify--test-events nil)) + file-notify--test-events nil + file-notify--test-monitors nil)) (setq password-cache-expiry nil tramp-verbose 0 @@ -210,10 +213,16 @@ remote host, or nil." "The used monitor for the test, as a symbol. This returns only for the local case and gfilenotify; otherwise it is nil. `file-notify--test-desc' must be a valid watch descriptor." - (and file-notify--test-desc - (null (file-remote-p temporary-file-directory)) - (functionp 'gfile-monitor-name) - (gfile-monitor-name file-notify--test-desc))) + ;; We cache the result, because after `file-notify-rm-watch', + ;; `gfile-monitor-name' does not return a proper result anymore. + ;; But we still need this information. + (unless (file-remote-p temporary-file-directory) + (or (cdr (assq file-notify--test-desc file-notify--test-monitors)) + (when (functionp 'gfile-monitor-name) + (add-to-list 'file-notify--test-monitors + (cons file-notify--test-desc + (gfile-monitor-name file-notify--test-desc))) + (cdr (assq file-notify--test-desc file-notify--test-monitors)))))) (defmacro file-notify--deftest-remote (test docstring) "Define ert `TEST-remote' for remote files." @@ -444,6 +453,12 @@ delivered." '(change) #'file-notify--test-event-handler))) (file-notify--test-with-events (cond + ;; gvfs-monitor-dir on cygwin does not detect the + ;; `created' event reliably. + ((string-equal + (file-notify--test-library) "gvfs-monitor-dir.exe") + '((deleted stopped) + (created deleted stopped))) ;; cygwin does not raise a `changed' event. ((eq system-type 'cygwin) '(created deleted stopped)) @@ -463,9 +478,15 @@ delivered." file-notify--test-tmpfile '(change) #'file-notify--test-event-handler))) (file-notify--test-with-events - ;; There could be one or two `changed' events. - '((changed deleted stopped) - (changed changed deleted stopped)) + (cond + ;; gvfs-monitor-dir on cygwin does not detect the + ;; `changed' event reliably. + ((string-equal (file-notify--test-library) "gvfs-monitor-dir.exe") + '((deleted stopped) + (changed deleted stopped))) + ;; There could be one or two `changed' events. + (t '((changed deleted stopped) + (changed changed deleted stopped)))) (write-region "another text" nil file-notify--test-tmpfile nil 'no-message) (file-notify--test-read-event) @@ -489,6 +510,12 @@ delivered." ;; events for the watched directory. ((string-equal (file-notify--test-library) "w32notify") '(created changed deleted)) + ;; gvfs-monitor-dir on cygwin does not detect the + ;; `created' event reliably. + ((string-equal + (file-notify--test-library) "gvfs-monitor-dir.exe") + '((deleted stopped) + (created deleted stopped))) ;; There are two `deleted' events, for the file and for ;; the directory. Except for cygwin and kqueue. And ;; cygwin does not raise a `changed' event. @@ -522,6 +549,12 @@ delivered." '(created changed created changed changed changed changed deleted deleted)) + ;; gvfs-monitor-dir on cygwin does not detect the + ;; `created' event reliably. + ((string-equal + (file-notify--test-library) "gvfs-monitor-dir.exe") + '((deleted stopped) + (created created deleted stopped))) ;; There are three `deleted' events, for two files and ;; for the directory. Except for cygwin and kqueue. ((eq system-type 'cygwin) @@ -559,6 +592,12 @@ delivered." ;; events for the watched directory. ((string-equal (file-notify--test-library) "w32notify") '(created changed renamed deleted)) + ;; gvfs-monitor-dir on cygwin does not detect the + ;; `created' event reliably. + ((string-equal + (file-notify--test-library) "gvfs-monitor-dir.exe") + '((deleted stopped) + (created deleted stopped))) ;; There are two `deleted' events, for the file and for ;; the directory. Except for cygwin and kqueue. And ;; cygwin raises `created' and `deleted' events instead @@ -578,8 +617,7 @@ delivered." (file-notify-rm-watch file-notify--test-desc)) ;; Check attribute change. Does not work for cygwin. - (unless (and (eq system-type 'cygwin) - (not (file-remote-p temporary-file-directory))) + (unless (eq system-type 'cygwin) (setq file-notify--test-tmpfile (file-notify--test-make-temp-name)) (write-region "any text" nil file-notify--test-tmpfile nil 'no-message) @@ -654,6 +692,11 @@ delivered." (while (null auto-revert-notify-watch-descriptor) (sleep-for 1))) + ;; `file-notify--test-monitor' needs to know + ;; `file-notify--test-desc' in order to compute proper + ;; timeouts. + (setq file-notify--test-desc auto-revert-notify-watch-descriptor) + ;; Check, that file notification has been used. (should auto-revert-mode) (should auto-revert-use-notify) @@ -748,9 +791,15 @@ delivered." '(change) #'file-notify--test-event-handler))) (should (file-notify-valid-p file-notify--test-desc)) (file-notify--test-with-events - ;; There could be one or two `changed' events. - '((changed deleted stopped) - (changed changed deleted stopped)) + (cond + ;; gvfs-monitor-dir on cygwin does not detect the + ;; `changed' event reliably. + ((string-equal (file-notify--test-library) "gvfs-monitor-dir.exe") + '((deleted stopped) + (changed deleted stopped))) + ;; There could be one or two `changed' events. + (t '((changed deleted stopped) + (changed changed deleted stopped)))) (write-region "another text" nil file-notify--test-tmpfile nil 'no-message) (file-notify--test-read-event) @@ -781,6 +830,11 @@ delivered." ;; for the watched directory. ((string-equal (file-notify--test-library) "w32notify") '(created changed deleted)) + ;; gvfs-monitor-dir on cygwin does not detect the `created' + ;; event reliably. + ((string-equal (file-notify--test-library) "gvfs-monitor-dir.exe") + '((deleted stopped) + (created deleted stopped))) ;; There are two `deleted' events, for the file and for the ;; directory. Except for cygwin and kqueue. And cygwin ;; does not raise a `changed' event. @@ -1043,7 +1097,9 @@ the file watch." (setq file-notify--test-desc1 (file-notify-add-watch file-notify--test-tmpfile - '(change) #'dir-callback))) + '(change) #'dir-callback) + ;; This is needed for `file-notify--test-monitor'. + file-notify--test-desc file-notify--test-desc1)) (should (setq file-notify--test-desc2 (file-notify-add-watch commit 1d714e41ea73af89b56fb4bf19f8f0c3f443c268 Author: Michael Albinus Date: Mon Jan 2 19:30:21 2017 +0100 Check also for "gvfs-monitor-dir.exe" in Tramp * lisp/net/tramp-sh.el (tramp-get-remote-gvfs-monitor-dir): Check also for "gvfs-monitor-dir.exe". diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index b0a2c431f9..fec9f10d70 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -5409,8 +5409,13 @@ Nonexistent directories are removed from spec." "Determine remote `gvfs-monitor-dir' command." (with-tramp-connection-property vec "gvfs-monitor-dir" (tramp-message vec 5 "Finding a suitable `gvfs-monitor-dir' command") - (tramp-find-executable - vec "gvfs-monitor-dir" (tramp-get-remote-path vec) t t))) + ;; We distinguish "gvfs-monitor-dir.exe" from cygwin in order to + ;; establish better timeouts in filenotify-tests.el. Any better + ;; distinction approach would be welcome! + (or (tramp-find-executable + vec "gvfs-monitor-dir.exe" (tramp-get-remote-path vec) t t) + (tramp-find-executable + vec "gvfs-monitor-dir" (tramp-get-remote-path vec) t t)))) (defun tramp-get-remote-inotifywait (vec) "Determine remote `inotifywait' command." commit 443f1719947060d87b87ee09aba7af30e75206dc Author: Eli Zaretskii Date: Mon Jan 2 18:55:27 2017 +0200 Fix compilation --without-x * src/composite.c (autocmp_chars) [HAVE_WINDOW_SYSTEM]: Call font_range only if it is compiled in. (Bug#25334) diff --git a/src/composite.c b/src/composite.c index 5e6d628bbf..f23bb17c57 100644 --- a/src/composite.c +++ b/src/composite.c @@ -891,6 +891,8 @@ autocmp_chars (Lisp_Object rule, ptrdiff_t charpos, ptrdiff_t bytepos, if (len <= 0) return unbind_to (count, Qnil); to = limit = charpos + len; + font_object = win->frame; +#ifdef HAVE_WINDOW_SYSTEM if (FRAME_WINDOW_P (f)) { font_object = font_range (charpos, bytepos, &to, win, face, string); @@ -900,8 +902,7 @@ autocmp_chars (Lisp_Object rule, ptrdiff_t charpos, ptrdiff_t bytepos, && (fast_looking_at (re, charpos, bytepos, to, -1, string) <= 0))) return unbind_to (count, Qnil); } - else - font_object = win->frame; +#endif lgstring = Fcomposition_get_gstring (pos, make_number (to), font_object, string); if (NILP (LGSTRING_ID (lgstring))) commit 1e8bb313eaa98928dc258f4b903bb10c33c21642 Author: Sašo Živanović Date: Fri Dec 30 11:12:42 2016 +0100 Fix RefTeX to show table of contents for dtx files (tiny change) * lisp/textmodes/reftex.el (reftex-compile-variables): Change the section regexp so that it accepts lines starting with the comment character. (tiny change) * lisp/textmodes/reftex-parse.el (reftex-parse-from-file): Filter gathered toc entries, accepting a commented entry if and only if the source file is a ".dtx" file. (tiny change) diff --git a/lisp/textmodes/reftex-parse.el b/lisp/textmodes/reftex-parse.el index a2de4166d2..af2810d72e 100644 --- a/lisp/textmodes/reftex-parse.el +++ b/lisp/textmodes/reftex-parse.el @@ -270,7 +270,10 @@ of master file." (when (eq (char-before) ?\\) (backward-char)) ;; Insert in List (setq toc-entry (funcall reftex-section-info-function file)) - (when toc-entry + (when (and toc-entry + (eq ;; Either both are t or both are nil. + (= (char-after bound) ?%) + (string-suffix-p ".dtx" file))) ;; It can happen that section info returns nil (setq level (nth 5 toc-entry)) (setq highest-level (min highest-level level)) diff --git a/lisp/textmodes/reftex.el b/lisp/textmodes/reftex.el index 2de83a8e33..18b35981f8 100644 --- a/lisp/textmodes/reftex.el +++ b/lisp/textmodes/reftex.el @@ -1015,8 +1015,8 @@ This enforces rescanning the buffer on next use." ;; Calculate the regular expressions (let* ( ; (wbol "\\(\\`\\|[\n\r]\\)[ \t]*") - (wbol "\\(^\\)[ \t]*") ; Need to keep the empty group because - ; match numbers are hard coded + (wbol "\\(^\\)%?[ \t]*") ; Need to keep the empty group because + ; match numbers are hard coded (label-re (concat "\\(?:" (mapconcat 'identity reftex-label-regexps "\\|") "\\)")) commit 367dadf5541f3cc10ba992efb885bd259246ca66 Author: Paul Eggert Date: Sun Jan 1 20:23:38 2017 -0800 Remove mistakenly-added files Problem reported by Glenn Morris in: http://lists.gnu.org/archive/html/emacs-devel/2017-01/msg00008.html * lisp/gnus/gnus-ems.el, lisp/gnus/gnus-sync.el: * lisp/gnus/messcompat.el, lisp/nxml/nxml-glyph.el: * lisp/nxml/nxml-uchnm.el, lisp/obsolete/awk-mode.el: * lisp/obsolete/iso-acc.el, lisp/obsolete/iso-insert.el: * lisp/obsolete/iso-swed.el, lisp/obsolete/resume.el: * lisp/obsolete/scribe.el, lisp/obsolete/spell.el: * lisp/obsolete/swedish.el, lisp/obsolete/sym-comp.el: Remove files that were added by mistake during a merge. diff --git a/lisp/gnus/gnus-ems.el b/lisp/gnus/gnus-ems.el deleted file mode 100644 index 5067fa43cd..0000000000 --- a/lisp/gnus/gnus-ems.el +++ /dev/null @@ -1,266 +0,0 @@ -;;; gnus-ems.el --- functions for making Gnus work under different Emacsen - -;; Copyright (C) 1995-2017 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news - -;; 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: - -(eval-when-compile - (require 'cl) - (require 'ring)) - -;;; Function aliases later to be redefined for XEmacs usage. - -(defvar gnus-mouse-2 [mouse-2]) -(defvar gnus-down-mouse-3 [down-mouse-3]) -(defvar gnus-down-mouse-2 [down-mouse-2]) -(defvar gnus-widget-button-keymap nil) -(defvar gnus-mode-line-modified - (if (featurep 'xemacs) - '("--**-" . "-----") - '("**" "--"))) - -(eval-and-compile - (autoload 'gnus-xmas-define "gnus-xmas") - (autoload 'gnus-xmas-redefine "gnus-xmas")) - -(autoload 'gnus-get-buffer-create "gnus") -(autoload 'nnheader-find-etc-directory "nnheader") -(autoload 'smiley-region "smiley") - -(defun gnus-kill-all-overlays () - "Delete all overlays in the current buffer." - (let* ((overlayss (overlay-lists)) - (buffer-read-only nil) - (overlays (delq nil (nconc (car overlayss) (cdr overlayss))))) - (while overlays - (delete-overlay (pop overlays))))) - -;;; Mule functions. - -(defun gnus-mule-max-width-function (el max-width) - `(let* ((val (eval (, el))) - (valstr (if (numberp val) - (int-to-string val) val))) - (if (> (length valstr) ,max-width) - (truncate-string-to-width valstr ,max-width) - valstr))) - -(eval-and-compile - (if (featurep 'xemacs) - (gnus-xmas-define) - (defvar gnus-mouse-face-prop 'mouse-face - "Property used for highlighting mouse regions."))) - -(defvar gnus-tmp-unread) -(defvar gnus-tmp-replied) -(defvar gnus-tmp-score-char) -(defvar gnus-tmp-indentation) -(defvar gnus-tmp-opening-bracket) -(defvar gnus-tmp-lines) -(defvar gnus-tmp-name) -(defvar gnus-tmp-closing-bracket) -(defvar gnus-tmp-subject-or-nil) -(defvar gnus-check-before-posting) -(defvar gnus-mouse-face) -(defvar gnus-group-buffer) - -(defun gnus-ems-redefine () - (cond - ((featurep 'xemacs) - (gnus-xmas-redefine)) - - ((featurep 'mule) - ;; Mule and new Emacs definitions - - ;; [Note] Now there are three kinds of mule implementations, - ;; original MULE, XEmacs/mule and Emacs 20+ including - ;; MULE features. Unfortunately these APIs are different. In - ;; particular, Emacs (including original Mule) and XEmacs are - ;; quite different. However, this version of Gnus doesn't support - ;; anything other than XEmacs 20+ and Emacs 20.3+. - - ;; Predicates to check are following: - ;; (boundp 'MULE) is t only if Mule (original; anything older than - ;; Mule 2.3) is running. - ;; (featurep 'mule) is t when other mule variants are running. - - ;; It is possible to detect XEmacs/mule by (featurep 'mule) and - ;; (featurep 'xemacs). In this case, the implementation for - ;; XEmacs/mule may be shareable between XEmacs and XEmacs/mule. - - (defvar gnus-summary-display-table nil - "Display table used in summary mode buffers.") - (defalias 'gnus-max-width-function 'gnus-mule-max-width-function) - - (when (boundp 'gnus-check-before-posting) - (setq gnus-check-before-posting - (delq 'long-lines - (delq 'control-chars gnus-check-before-posting)))) - - (defun gnus-summary-line-format-spec () - (insert gnus-tmp-unread gnus-tmp-replied - gnus-tmp-score-char gnus-tmp-indentation) - (put-text-property - (point) - (progn - (insert - gnus-tmp-opening-bracket - (format "%4d: %-20s" - gnus-tmp-lines - (if (> (length gnus-tmp-name) 20) - (truncate-string-to-width gnus-tmp-name 20) - gnus-tmp-name)) - gnus-tmp-closing-bracket) - (point)) - gnus-mouse-face-prop gnus-mouse-face) - (insert " " gnus-tmp-subject-or-nil "\n"))))) - -;; Clone of `appt-select-lowest-window' in appt.el. -(defun gnus-select-lowest-window () -"Select the lowest window on the frame." - (let ((lowest-window (selected-window)) - (bottom-edge (nth 3 (window-edges)))) - (walk-windows (lambda (w) - (let ((next-bottom-edge (nth 3 (window-edges w)))) - (when (< bottom-edge next-bottom-edge) - (setq bottom-edge next-bottom-edge - lowest-window w))))) - (select-window lowest-window))) - -(defun gnus-region-active-p () - "Say whether the region is active." - (and (boundp 'transient-mark-mode) - transient-mark-mode - (boundp 'mark-active) - mark-active)) - -(defun gnus-mark-active-p () - "Non-nil means the mark and region are currently active in this buffer." - mark-active) ; aliased to region-exists-p in XEmacs. - -(autoload 'gnus-alive-p "gnus-util") -(autoload 'mm-disable-multibyte "mm-util") - -;;; Image functions. - -(defun gnus-image-type-available-p (type) - (and (fboundp 'image-type-available-p) - (if (fboundp 'display-images-p) - (display-images-p) - t) - (image-type-available-p type))) - -(defun gnus-create-image (file &optional type data-p &rest props) - (let ((face (plist-get props :face))) - (when face - (setq props (plist-put props :foreground (face-foreground face))) - (setq props (plist-put props :background (face-background face)))) - (ignore-errors - (apply 'create-image file type data-p props)))) - -(defun gnus-put-image (glyph &optional string category) - (let ((point (point))) - (insert-image glyph (or string " ")) - (put-text-property point (point) 'gnus-image-category category) - (unless string - (put-text-property (1- (point)) (point) - 'gnus-image-text-deletable t)) - glyph)) - -(defun gnus-remove-image (image &optional category) - "Remove the image matching IMAGE and CATEGORY found first." - (let ((start (point-min)) - val end) - (while (and (not end) - (or (setq val (get-text-property start 'display)) - (and (setq start - (next-single-property-change start 'display)) - (setq val (get-text-property start 'display))))) - (setq end (or (next-single-property-change start 'display) - (point-max))) - (if (and (equal val image) - (equal (get-text-property start 'gnus-image-category) - category)) - (progn - (put-text-property start end 'display nil) - (when (get-text-property start 'gnus-image-text-deletable) - (delete-region start end))) - (unless (= end (point-max)) - (setq start end - end nil)))))) - -(defmacro gnus-string-mark-left-to-right (string) - (if (fboundp 'bidi-string-mark-left-to-right) - `(bidi-string-mark-left-to-right ,string) - string)) - -(eval-and-compile - ;; XEmacs does not have window-inside-pixel-edges - (defalias 'gnus-window-inside-pixel-edges - (if (fboundp 'window-inside-pixel-edges) - 'window-inside-pixel-edges - 'window-pixel-edges)) - - (if (or (featurep 'emacs) (fboundp 'set-process-plist)) - (progn ; these exist since Emacs 22.1 - (defalias 'gnus-set-process-plist 'set-process-plist) - (defalias 'gnus-process-plist 'process-plist) - (defalias 'gnus-process-get 'process-get) - (defalias 'gnus-process-put 'process-put)) - (defun gnus-set-process-plist (process plist) - "Replace the plist of PROCESS with PLIST. Returns PLIST." - (put 'gnus-process-plist-internal process plist)) - - (defun gnus-process-plist (process) - "Return the plist of PROCESS." - ;; This form works but can't prevent the plist data from - ;; growing infinitely. - ;;(get 'gnus-process-plist-internal process) - (let* ((plist (symbol-plist 'gnus-process-plist-internal)) - (tem (memq process plist))) - (prog1 - (cadr tem) - ;; Remove it from the plist data. - (when tem - (if (eq plist tem) - (progn - (setcar plist (caddr plist)) - (setcdr plist (or (cdddr plist) '(nil)))) - (setcdr (nthcdr (- (length plist) (length tem) 1) plist) - (cddr tem))))))) - - (defun gnus-process-get (process propname) - "Return the value of PROCESS' PROPNAME property. -This is the last value stored with `(gnus-process-put PROCESS PROPNAME VALUE)'." - (plist-get (gnus-process-plist process) propname)) - - (defun gnus-process-put (process propname value) - "Change PROCESS' PROPNAME property to VALUE. -It can be retrieved with `(gnus-process-get PROCESS PROPNAME)'." - (gnus-set-process-plist process - (plist-put (gnus-process-plist process) - propname value))))) - -(provide 'gnus-ems) - -;;; gnus-ems.el ends here diff --git a/lisp/gnus/gnus-sync.el b/lisp/gnus/gnus-sync.el deleted file mode 100644 index 8a3e45aff3..0000000000 --- a/lisp/gnus/gnus-sync.el +++ /dev/null @@ -1,917 +0,0 @@ -;;; gnus-sync.el --- synchronization facility for Gnus - -;; Copyright (C) 2010-2017 Free Software Foundation, Inc. - -;; Author: Ted Zlatanov -;; Keywords: news synchronization nntp nnrss - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Commentary: - -;; This is the gnus-sync.el package. - -;; Put this in your startup file (~/.gnus.el for instance) - -;; possibilities for gnus-sync-backend: -;; Tramp over SSH: /ssh:user@host:/path/to/filename -;; ...or any other file Tramp and Emacs can handle... - -;; (setq gnus-sync-backend "/remote:/path.gpg" ; will use Tramp+EPA if loaded -;; gnus-sync-global-vars '(gnus-newsrc-last-checked-date) -;; gnus-sync-newsrc-groups '("nntp" "nnrss")) -;; gnus-sync-newsrc-offsets '(2 3)) -;; against a LeSync server (beware the vampire LeSync, who knows your newsrc) - -;; (setq gnus-sync-backend '(lesync "http://lesync.info:5984/tzz") -;; gnus-sync-newsrc-groups '("nntp" "nnrss")) - -;; What's a LeSync server? - -;; 1. install CouchDB, set up a real server admin user, and create a -;; database, e.g. "tzz" and save the URL, -;; e.g. http://lesync.info:5984/tzz - -;; 2. run `M-: (gnus-sync-lesync-setup "http://lesync.info:5984/tzz" "tzzadmin" "mypassword" "mysalt" t t)' - -;; (If you run it more than once, you have to remove the entry from -;; _users yourself. This is intentional. This sets up a database -;; admin for the "tzz" database, distinct from the server admin -;; user in (1) above.) - -;; That's it, you can start using http://lesync.info:5984/tzz in your -;; gnus-sync-backend as a LeSync backend. Fan fiction about the -;; vampire LeSync is welcome. - -;; You may not want to expose a CouchDB install to the Big Bad -;; Internet, especially if your love of all things furry would be thus -;; revealed. Make sure it's not accessible by unauthorized users and -;; guests, at least. - -;; If you want to try it out, I will create a test DB for you under -;; http://lesync.info:5984/yourfavoritedbname - -;; TODO: - -;; - after gnus-sync-read, the message counts look wrong until you do -;; `g'. So it's not run automatically, you have to call it with M-x -;; gnus-sync-read - -;; - use gnus-after-set-mark-hook and gnus-before-update-mark-hook to -;; catch the mark updates - -;; - repositioning of groups within topic after a LeSync sync is a -;; weird sort of bubble sort ("buttle" sort: the old entry ends up -;; at the rear of the list); you will eventually end up with the -;; right order after calling `gnus-sync-read' a bunch of times. - -;; - installing topics and groups is inefficient and annoying, lots of -;; prompts could be avoided - -;;; Code: - -(eval-when-compile (require 'cl)) -(require 'json) -(require 'gnus) -(require 'gnus-start) -(require 'gnus-util) - -(defvar gnus-topic-alist) ;; gnus-group.el -(autoload 'gnus-group-topic "gnus-topic") - -(defgroup gnus-sync nil - "The Gnus synchronization facility." - :version "24.1" - :group 'gnus) - -(defcustom gnus-sync-newsrc-groups '("nntp" "nnrss") - "List of groups to be synchronized in the gnus-newsrc-alist. -The group names are matched, they don't have to be fully -qualified. Typically you would choose all of these. That's the -default because there is no active sync backend by default, so -this setting is harmless until the user chooses a sync backend." - :group 'gnus-sync - :type '(repeat regexp)) - -(defcustom gnus-sync-newsrc-offsets '(2 3) - "List of per-group data to be synchronized." - :group 'gnus-sync - :version "24.4" - :type '(set (const :tag "Read ranges" 2) - (const :tag "Marks" 3))) - -(defcustom gnus-sync-global-vars nil - "List of global variables to be synchronized. -You may want to sync `gnus-newsrc-last-checked-date' but pretty -much any symbol is fair game. You could additionally sync -`gnus-newsrc-alist', `gnus-server-alist', `gnus-topic-topology', -and `gnus-topic-alist'. Also see `gnus-variable-list'." - :group 'gnus-sync - :type '(repeat (choice (variable :tag "A known variable") - (symbol :tag "Any symbol")))) - -(defcustom gnus-sync-backend nil - "The synchronization backend." - :group 'gnus-sync - :type '(radio (const :format "None" nil) - (list :tag "Sync server" - (const :format "LeSync Server API" lesync) - (string :tag "URL of a CouchDB database for API access")) - (string :tag "Sync to a file"))) - -(defvar gnus-sync-newsrc-loader nil - "Carrier for newsrc data") - -(defcustom gnus-sync-file-encrypt-to nil - "If non-nil, set `epa-file-encrypt-to' from this for encrypting the Sync file." - :version "24.4" - :type '(choice string (repeat string)) - :group 'gnus-sync) - -(defcustom gnus-sync-lesync-name (system-name) - "The LeSync name for this machine." - :group 'gnus-sync - :version "24.3" - :type 'string) - -(defcustom gnus-sync-lesync-install-topics 'ask - "Should LeSync install the recorded topics?" - :group 'gnus-sync - :version "24.3" - :type '(choice (const :tag "Never Install" nil) - (const :tag "Always Install" t) - (const :tag "Ask Me Once" ask))) - -(defvar gnus-sync-lesync-props-hash (make-hash-table :test 'equal) - "LeSync props, keyed by group name") - -(defvar gnus-sync-lesync-design-prefix "/_design/lesync" - "The LeSync design prefix for CouchDB") - -(defvar gnus-sync-lesync-security-object "/_security" - "The LeSync security object for CouchDB") - -(defun gnus-sync-lesync-parse () - "Parse the result of a LeSync request." - (goto-char (point-min)) - (condition-case nil - (when (search-forward-regexp "^$" nil t) - (json-read)) - (error - (gnus-message - 1 - "gnus-sync-lesync-parse: Could not read the LeSync response!") - nil))) - -(defun gnus-sync-lesync-call (url method headers &optional kvdata) - "Make an access request to URL using KVDATA and METHOD. -KVDATA must be an alist." - (let ((url-request-method method) - (url-request-extra-headers headers) - (url-request-data (if kvdata (json-encode kvdata) nil))) - (with-current-buffer (url-retrieve-synchronously url) - (let ((data (gnus-sync-lesync-parse))) - (gnus-message 12 "gnus-sync-lesync-call: %s URL %s sent %S got %S" - method url `((headers . ,headers) (data ,kvdata)) data) - (kill-buffer (current-buffer)) - data)))) - -(defun gnus-sync-lesync-PUT (url headers &optional data) - (gnus-sync-lesync-call url "PUT" headers data)) - -(defun gnus-sync-lesync-POST (url headers &optional data) - (gnus-sync-lesync-call url "POST" headers data)) - -(defun gnus-sync-lesync-GET (url headers &optional data) - (gnus-sync-lesync-call url "GET" headers data)) - -(defun gnus-sync-lesync-DELETE (url headers &optional data) - (gnus-sync-lesync-call url "DELETE" headers data)) - -;; this is not necessary with newer versions of json.el but 1.2 or older -;; (which are in Emacs 24.1 and earlier) need it -(defun gnus-sync-json-alist-p (list) - "Non-null if and only if LIST is an alist." - (while (consp list) - (setq list (if (consp (car list)) - (cdr list) - 'not-alist))) - (null list)) - -;; this is not necessary with newer versions of json.el but 1.2 or older -;; (which are in Emacs 24.1 and earlier) need it -(defun gnus-sync-json-plist-p (list) - "Non-null if and only if LIST is a plist." - (while (consp list) - (setq list (if (and (keywordp (car list)) - (consp (cdr list))) - (cddr list) - 'not-plist))) - (null list)) - -; (gnus-sync-lesync-setup "http://lesync.info:5984/tzz" "tzzadmin" "mypassword" "mysalt" t t) -; (gnus-sync-lesync-setup "http://lesync.info:5984/tzz") - -(defun gnus-sync-lesync-setup (url &optional user password salt reader admin) - (interactive "sEnter URL to set up: ") - "Set up the LeSync database at URL. -Install USER as a READER and/or an ADMIN in the security object -under \"_security\", and in the CouchDB \"_users\" table using -PASSWORD and SALT. Only one USER is thus supported for now. -When SALT is nil, a random one will be generated using `random'." - (let* ((design-url (concat url gnus-sync-lesync-design-prefix)) - (security-object (concat url "/_security")) - (user-record `((names . [,user]) (roles . []))) - (couch-user-name (format "org.couchdb.user:%s" user)) - (salt (or salt (sha1 (format "%s" (random))))) - (couch-user-record - `((_id . ,couch-user-name) - (type . user) - (name . ,(format "%s" user)) - (roles . []) - (salt . ,salt) - (password_sha . ,(when password - (sha1 - (format "%s%s" password salt)))))) - (rev (progn - (gnus-sync-lesync-find-prop 'rev design-url design-url) - (gnus-sync-lesync-get-prop 'rev design-url))) - (latest-func "function(head,req) -{ - var tosend = []; - var row; - var ftime = (req.query['ftime'] || 0); - while (row = getRow()) - { - if (row.value['float-time'] > ftime) - { - var s = row.value['_id']; - if (s) tosend.push('\"'+s.replace('\"', '\\\"')+'\"'); - } - } - send('['+tosend.join(',') + ']'); -}") -;; read -;; -;; de.alt.fan.ipod -;; -;; 1 -;; 2 -;; -;; start -;; 100 -;; length -;; 100 -;; -;; -;; - (xmlplistread-func "function(head, req) { - var row; - start({ 'headers': { 'Content-Type': 'text/xml' } }); - - send(''); - send('read'); - send(''); - while(row = getRow()) - { - var read = row.value.read; - if (read && read[0] && read[0] == 'invlist') - { - send(''+row.key+''); - //send(''+read+''); - send(''); - - var from = 0; - var flip = false; - - for (var i = 1; i < read.length && read[i]; i++) - { - var cur = read[i]; - if (flip) - { - if (from == cur-1) - { - send(''+read[i]+''); - } - else - { - send(''); - send('start'); - send(''+from+''); - send('end'); - send(''+(cur-1)+''); - send(''); - } - - } - flip = ! flip; - from = cur; - } - send(''); - } - } - - send(''); - send(''); -} -") - (subs-func "function(doc){emit([doc._id, doc.source], doc._rev);}") - (revs-func "function(doc){emit(doc._id, doc._rev);}") - (bytimesubs-func "function(doc) -{emit([(doc['float-time']||0), doc._id], doc._rev);}") - (bytime-func "function(doc) -{emit([(doc['float-time']||0), doc._id], doc);}") - (groups-func "function(doc){emit(doc._id, doc);}")) - (and (if user - (and (assq 'ok (gnus-sync-lesync-PUT - security-object - nil - (append (and reader - (list `(readers . ,user-record))) - (and admin - (list `(admins . ,user-record)))))) - (assq 'ok (gnus-sync-lesync-PUT - (concat (file-name-directory url) - "_users/" - couch-user-name) - nil - couch-user-record))) - t) - (assq 'ok (gnus-sync-lesync-PUT - design-url - nil - `(,@(when rev (list (cons '_rev rev))) - (lists . ((latest . ,latest-func) - (xmlplistread . ,xmlplistread-func))) - (views . ((subs . ((map . ,subs-func))) - (revs . ((map . ,revs-func))) - (bytimesubs . ((map . ,bytimesubs-func))) - (bytime . ((map . ,bytime-func))) - (groups . ((map . ,groups-func))))))))))) - -(defun gnus-sync-lesync-find-prop (prop url key) - "Retrieve a PROPerty of a document KEY at URL. -Calls `gnus-sync-lesync-set-prop'. -For the 'rev PROP, uses '_rev against the document." - (gnus-sync-lesync-set-prop - prop key (cdr (assq (if (eq prop 'rev) '_rev prop) - (gnus-sync-lesync-GET url nil))))) - -(defun gnus-sync-lesync-set-prop (prop key val) - "Update the PROPerty of document KEY at URL to VAL. -Updates `gnus-sync-lesync-props-hash'." - (puthash (format "%s.%s" key prop) val gnus-sync-lesync-props-hash)) - -(defun gnus-sync-lesync-get-prop (prop key) - "Get the PROPerty of KEY from `gnus-sync-lesync-props-hash'." - (gethash (format "%s.%s" key prop) gnus-sync-lesync-props-hash)) - -(defun gnus-sync-deep-print (data) - (let* ((print-quoted t) - (print-readably t) - (print-escape-multibyte nil) - (print-escape-nonascii t) - (print-length nil) - (print-level nil) - (print-circle nil) - (print-escape-newlines t)) - (format "%S" data))) - -(defun gnus-sync-newsrc-loader-builder (&optional only-modified) - (let* ((entries (cdr gnus-newsrc-alist)) - entry name ret) - (while entries - (setq entry (pop entries) - name (car entry)) - (when (gnus-grep-in-list name gnus-sync-newsrc-groups) - (if only-modified - (when (not (equal (gnus-sync-deep-print entry) - (gnus-sync-lesync-get-prop 'checksum name))) - (gnus-message 9 "%s: add %s, it's modified" - "gnus-sync-newsrc-loader-builder" name) - (push entry ret)) - (push entry ret)))) - ret)) - -; (json-encode (gnus-sync-range2invlist '((1 . 47137) (47139 . 47714) 48129 48211 49231 49281 49342 49473 49475 49502))) -(defun gnus-sync-range2invlist (ranges) - (append '(invlist) - (let ((ranges (delq nil ranges)) - ret range from to) - (while ranges - (setq range (pop ranges)) - (if (atom range) - (setq from range - to range) - (setq from (car range) - to (cdr range))) - (push from ret) - (push (1+ to) ret)) - (reverse ret)))) - -; (let* ((d '((1 . 47137) (47139 . 47714) 48129 48211 49231 49281 49342 49473 49475 49502)) (j (format "%S" (gnus-sync-invlist2range (gnus-sync-range2invlist d))))) (or (equal (format "%S" d) j) j)) -(defun gnus-sync-invlist2range (inv) - (setq inv (append inv nil)) - (if (equal (format "%s" (car inv)) "invlist") - (let ((i (cdr inv)) - (start 0) - ret cur top flip) - (while i - (setq cur (pop i)) - (when flip - (setq top (1- cur)) - (if (= start top) - (push start ret) - (push (cons start top) ret))) - (setq flip (not flip)) - (setq start cur)) - (reverse ret)) - inv)) - -(defun gnus-sync-position (search list &optional test) - "Find the position of SEARCH in LIST using TEST, defaulting to `eq'." - (let ((pos 0) - (test (or test 'eq))) - (while (and list (not (funcall test (car list) search))) - (pop list) - (incf pos)) - (if (funcall test (car list) search) pos nil))) - -(defun gnus-sync-topic-group-position (group topic-name) - (gnus-sync-position - group (cdr (assoc topic-name gnus-topic-alist)) 'equal)) - -(defun gnus-sync-fix-topic-group-position (group topic-name position) - (unless (equal position (gnus-sync-topic-group-position group topic-name)) - (let* ((loc "gnus-sync-fix-topic-group-position") - (groups (delete group (cdr (assoc topic-name gnus-topic-alist)))) - (position (min position (1- (length groups)))) - (old (nth position groups))) - (when (and old (not (equal old group))) - (setf (nth position groups) group) - (setcdr (assoc topic-name gnus-topic-alist) - (append groups (list old))) - (gnus-message 9 "%s: %s moved to %d, swap with %s" - loc group position old))))) - -(defun gnus-sync-lesync-pre-save-group-entry (url nentry &rest passed-props) - (let* ((loc "gnus-sync-lesync-save-group-entry") - (k (car nentry)) - (revision (gnus-sync-lesync-get-prop 'rev k)) - (sname gnus-sync-lesync-name) - (topic (gnus-group-topic k)) - (topic-offset (gnus-sync-topic-group-position k topic)) - (sources (gnus-sync-lesync-get-prop 'source k))) - ;; set the revision so we don't have a conflict - `(,@(when revision - (list (cons '_rev revision))) - (_id . ,k) - ;; the time we saved - ,@passed-props - ;; add our name to the sources list for this key - (source ,@(if (member gnus-sync-lesync-name sources) - sources - (cons gnus-sync-lesync-name sources))) - ,(cons 'level (nth 1 nentry)) - ,@(if topic (list (cons 'topic topic)) nil) - ,@(if topic-offset (list (cons 'topic-offset topic-offset)) nil) - ;; the read marks - ,(cons 'read (gnus-sync-range2invlist (nth 2 nentry))) - ;; the other marks - ,@(delq nil (mapcar (lambda (mark-entry) - (gnus-message 12 "%s: prep param %s in %s" - loc - (car mark-entry) - (nth 3 nentry)) - (if (listp (cdr mark-entry)) - (cons (car mark-entry) - (gnus-sync-range2invlist - (cdr mark-entry))) - (progn ; else this is not a list - (gnus-message 9 "%s: non-list param %s in %s" - loc - (car mark-entry) - (nth 3 nentry)) - nil))) - (nth 3 nentry)))))) - -(defun gnus-sync-lesync-post-save-group-entry (url entry) - (let* ((loc "gnus-sync-lesync-post-save-group-entry") - (k (cdr (assq 'id entry)))) - (cond - ;; success! - ((and (assq 'rev entry) (assq 'id entry)) - (progn - (gnus-sync-lesync-set-prop 'rev k (cdr (assq 'rev entry))) - (gnus-sync-lesync-set-prop 'checksum - k - (gnus-sync-deep-print - (assoc k gnus-newsrc-alist))) - (gnus-message 9 "%s: successfully synced %s to %s" - loc k url))) - ;; specifically check for document conflicts - ((equal "conflict" (format "%s" (cdr-safe (assq 'error entry)))) - (gnus-error - 1 - "%s: use `%s' to resolve the conflict synchronizing %s to %s: %s" - loc "gnus-sync-read" k url (cdr (assq 'reason entry)))) - ;; generic errors - ((assq 'error entry) - (gnus-error 1 "%s: got error while synchronizing %s to %s: %s" - loc k url (cdr (assq 'reason entry)))) - - (t - (gnus-message 2 "%s: unknown sync status after %s to %s: %S" - loc k url entry))) - (assoc 'error entry))) - -(defun gnus-sync-lesync-groups-builder (url) - (let ((u (concat url gnus-sync-lesync-design-prefix "/_view/groups"))) - (cdr (assq 'rows (gnus-sync-lesync-GET u nil))))) - -(defun gnus-sync-subscribe-group (name) - "Subscribe to group NAME. Returns NAME on success, nil otherwise." - (gnus-subscribe-newsgroup name)) - -(defun gnus-sync-lesync-read-group-entry (url name entry &rest passed-props) - "Read ENTRY information for NAME. Returns NAME if successful. -Skips entries whose sources don't contain -`gnus-sync-lesync-name'. When the alist PASSED-PROPS has a -`subscribe-all' element that evaluates to true, we attempt to -subscribe to unknown groups. The user is also allowed to delete -unwanted groups via the LeSync URL." - (let* ((loc "gnus-sync-lesync-read-group-entry") - (entry (gnus-sync-lesync-normalize-group-entry entry passed-props)) - (subscribe-all (cdr (assq 'subscribe-all passed-props))) - (sources (cdr (assq 'source entry))) - (rev (cdr (assq 'rev entry))) - (in-sources (member gnus-sync-lesync-name sources)) - (known (assoc name gnus-newsrc-alist)) - cell) - (unless known - (if (and subscribe-all - (y-or-n-p (format "Subscribe to group %s?" name))) - (setq known (gnus-sync-subscribe-group name) - in-sources t) - ;; else... - (when (y-or-n-p (format "Delete group %s from server?" name)) - (if (equal name (gnus-sync-lesync-delete-group url name)) - (gnus-message 1 "%s: removed group %s from server %s" - loc name url) - (gnus-error 1 "%s: could not remove group %s from server %s" - loc name url))))) - (when known - (unless in-sources - (setq in-sources - (y-or-n-p - (format "Read group %s even though %s is not in sources %S?" - name gnus-sync-lesync-name (or sources "")))))) - (when rev - (gnus-sync-lesync-set-prop 'rev name rev)) - - ;; if the source matches AND we have this group - (if (and known in-sources) - (progn - (gnus-message 10 "%s: reading LeSync entry %s, sources %S" - loc name sources) - (while entry - (setq cell (pop entry)) - (let ((k (car cell)) - (val (cdr cell))) - (gnus-sync-lesync-set-prop k name val))) - name) - ;; else... - (unless known - (gnus-message 5 "%s: ignoring entry %s, it wasn't subscribed. %s" - loc name "Call `gnus-sync-read' with C-u to force it.")) - (unless in-sources - (gnus-message 5 "%s: ignoring entry %s, %s not in sources %S" - loc name gnus-sync-lesync-name (or sources ""))) - nil))) - -(declare-function gnus-topic-create-topic "gnus-topic" - (topic parent &optional previous full-topic)) -(declare-function gnus-topic-enter-dribble "gnus-topic" ()) - -(defun gnus-sync-lesync-install-group-entry (name) - (let* ((master (assoc name gnus-newsrc-alist)) - (old-topic-name (gnus-group-topic name)) - (old-topic (assoc old-topic-name gnus-topic-alist)) - (target-topic-name (gnus-sync-lesync-get-prop 'topic name)) - (target-topic-offset (gnus-sync-lesync-get-prop 'topic-offset name)) - (target-topic (assoc target-topic-name gnus-topic-alist)) - (loc "gnus-sync-lesync-install-group-entry")) - (if master - (progn - (when (eq 'ask gnus-sync-lesync-install-topics) - (setq gnus-sync-lesync-install-topics - (y-or-n-p "Install topics from LeSync?"))) - (when (and (eq t gnus-sync-lesync-install-topics) - target-topic-name) - (if (equal old-topic-name target-topic-name) - (gnus-message 12 "%s: %s is already in topic %s" - loc name target-topic-name) - ;; see `gnus-topic-move-group' - (when (and old-topic target-topic) - (setcdr old-topic (gnus-delete-first name (cdr old-topic))) - (gnus-message 5 "%s: removing %s from topic %s" - loc name old-topic-name)) - (unless target-topic - (when (y-or-n-p (format "Create missing topic %s?" - target-topic-name)) - (gnus-topic-create-topic target-topic-name nil) - (setq target-topic (assoc target-topic-name - gnus-topic-alist)))) - (if target-topic - (prog1 - (nconc target-topic (list name)) - (gnus-message 5 "%s: adding %s to topic %s" - loc name (car target-topic)) - (gnus-topic-enter-dribble)) - (gnus-error 2 "%s: LeSync group %s can't go in missing topic %s" - loc name target-topic-name))) - (when (and target-topic-offset target-topic) - (gnus-sync-fix-topic-group-position - name target-topic-name target-topic-offset))) - ;; install the subscription level - (when (gnus-sync-lesync-get-prop 'level name) - (setf (nth 1 master) (gnus-sync-lesync-get-prop 'level name))) - ;; install the read and other marks - (setf (nth 2 master) (gnus-sync-lesync-get-prop 'read name)) - (setf (nth 3 master) (gnus-sync-lesync-get-prop 'marks name)) - (gnus-sync-lesync-set-prop 'checksum - name - (gnus-sync-deep-print master)) - nil) - (gnus-error 1 "%s: invalid LeSync group %s" loc name) - 'invalid-name))) - -; (gnus-sync-lesync-delete-group (cdr gnus-sync-backend) "nntp+Gmane:gwene.org.slashdot") - -(defun gnus-sync-lesync-delete-group (url name) - "Returns NAME if successful deleting it from URL, an error otherwise." - (interactive "sEnter URL to set up: \rsEnter group name: ") - (let* ((u (concat (cadr gnus-sync-backend) "/" (url-hexify-string name))) - (del (gnus-sync-lesync-DELETE - u - `(,@(when (gnus-sync-lesync-get-prop 'rev name) - (list (cons "If-Match" - (gnus-sync-lesync-get-prop 'rev name)))))))) - (or (cdr (assq 'id del)) del))) - -;;; (gnus-sync-lesync-normalize-group-entry '((subscribe . ["invlist"]) (read . ["invlist"]) (topic-offset . 20) (topic . "news") (level . 6) (source . ["a" "b"]) (float-time . 1319671237.099285) (_rev . "10-edf5107f41e5e6f7f6629d1c0ee172f7") (_id . "nntp+news.net:alt.movies")) '((read-time 1319672156.486414) (subscribe-all nil))) - -(defun gnus-sync-lesync-normalize-group-entry (entry &optional passed-props) - (let (ret - marks - cell) - (setq entry (append passed-props entry)) - (while (setq cell (pop entry)) - (let ((k (car cell)) - (val (cdr cell))) - (cond - ((eq k 'read) - (push (cons k (gnus-sync-invlist2range val)) ret)) - ;; we ignore these parameters - ((member k '(_id subscribe-all _deleted_conflicts)) - nil) - ((eq k '_rev) - (push (cons 'rev val) ret)) - ((eq k 'source) - (push (cons 'source (append val nil)) ret)) - ((or (eq k 'float-time) - (eq k 'level) - (eq k 'topic) - (eq k 'topic-offset) - (eq k 'read-time)) - (push (cons k val) ret)) -;;; "How often have I said to you that when you have eliminated the -;;; impossible, whatever remains, however improbable, must be the -;;; truth?" --Sherlock Holmes - ;; everything remaining must be a mark - (t (push (cons k (gnus-sync-invlist2range val)) marks))))) - (cons (cons 'marks marks) ret))) - -(defun gnus-sync-save (&optional force) -"Save the Gnus sync data to the backend. -With a prefix, FORCE is set and all groups will be saved." - (interactive "P") - (cond - ((and (listp gnus-sync-backend) - (eq (nth 0 gnus-sync-backend) 'lesync) - (stringp (nth 1 gnus-sync-backend))) - - ;; refresh the revisions if we're forcing the save - (when force - (mapc (lambda (entry) - (when (and (assq 'key entry) - (assq 'value entry)) - (gnus-sync-lesync-set-prop - 'rev - (cdr (assq 'key entry)) - (cdr (assq 'value entry))))) - ;; the revs view is key = name, value = rev - (cdr (assq 'rows (gnus-sync-lesync-GET - (concat (nth 1 gnus-sync-backend) - gnus-sync-lesync-design-prefix - "/_view/revs") - nil))))) - - (let* ((ftime (float-time)) - (url (nth 1 gnus-sync-backend)) - (entries - (mapcar (lambda (entry) - (gnus-sync-lesync-pre-save-group-entry - (cadr gnus-sync-backend) - entry - (cons 'float-time ftime))) - (gnus-sync-newsrc-loader-builder (not force)))) - ;; when there are no entries, there's nothing to save - (sync (if entries - (gnus-sync-lesync-POST - (concat url "/_bulk_docs") - '(("Content-Type" . "application/json")) - `((docs . ,(vconcat entries nil)))) - (gnus-message - 2 "gnus-sync-save: nothing to save to the LeSync backend") - nil))) - (mapcar (lambda (e) (gnus-sync-lesync-post-save-group-entry url e)) - sync))) - ((stringp gnus-sync-backend) - (gnus-message 7 "gnus-sync-save: saving to backend %s" gnus-sync-backend) - ;; populate gnus-sync-newsrc-loader from all but the first dummy - ;; entry in gnus-newsrc-alist whose group matches any of the - ;; gnus-sync-newsrc-groups - ;; TODO: keep the old contents for groups we don't have! - (let ((gnus-sync-newsrc-loader - (loop for entry in (cdr gnus-newsrc-alist) - when (gnus-grep-in-list - (car entry) ;the group name - gnus-sync-newsrc-groups) - collect (cons (car entry) - (mapcar (lambda (offset) - (cons offset (nth offset entry))) - gnus-sync-newsrc-offsets))))) - (with-temp-file gnus-sync-backend - (progn - (let ((coding-system-for-write gnus-ding-file-coding-system) - (standard-output (current-buffer))) - (when gnus-sync-file-encrypt-to - (set (make-local-variable 'epa-file-encrypt-to) - gnus-sync-file-encrypt-to)) - (princ (format ";; -*- mode:emacs-lisp; coding: %s; -*-\n" - gnus-ding-file-coding-system)) - (princ ";; Gnus sync data v. 0.0.1\n") - ;; TODO: replace with `gnus-sync-deep-print' - (let* ((print-quoted t) - (print-readably t) - (print-escape-multibyte nil) - (print-escape-nonascii t) - (print-length nil) - (print-level nil) - (print-circle nil) - (print-escape-newlines t) - (variables (cons 'gnus-sync-newsrc-loader - gnus-sync-global-vars)) - variable) - (while variables - (if (and (boundp (setq variable (pop variables))) - (symbol-value variable)) - (progn - (princ "\n(setq ") - (princ (symbol-name variable)) - (princ " '") - (prin1 (symbol-value variable)) - (princ ")\n")) - (princ "\n;;; skipping empty variable ") - (princ (symbol-name variable))))) - (gnus-message - 7 - "gnus-sync-save: stored variables %s and %d groups in %s" - gnus-sync-global-vars - (length gnus-sync-newsrc-loader) - gnus-sync-backend) - - ;; Idea from Dan Christensen - ;; Save the .eld file with extra line breaks. - (gnus-message 8 "gnus-sync-save: adding whitespace to %s" - gnus-sync-backend) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward "^(\\|(\\\"" nil t) - (replace-match "\n\\&" t)) - (goto-char (point-min)) - (while (re-search-forward " $" nil t) - (replace-match "" t t)))))))) - ;; the pass-through case: gnus-sync-backend is not a known choice - (nil))) - -(defun gnus-sync-read (&optional subscribe-all) - "Load the Gnus sync data from the backend. -With a prefix, SUBSCRIBE-ALL is set and unknown groups will be subscribed." - (interactive "P") - (when gnus-sync-backend - (gnus-message 7 "gnus-sync-read: loading from backend %s" gnus-sync-backend) - (cond - ((and (listp gnus-sync-backend) - (eq (nth 0 gnus-sync-backend) 'lesync) - (stringp (nth 1 gnus-sync-backend))) - (let ((errored nil) - name ftime) - (mapc (lambda (entry) - (setq name (cdr (assq 'id entry))) - ;; set ftime the FIRST time through this loop, that - ;; way it reflects the time we FINISHED reading - (unless ftime (setq ftime (float-time))) - - (unless errored - (setq errored - (when (equal name - (gnus-sync-lesync-read-group-entry - (nth 1 gnus-sync-backend) - name - (cdr (assq 'value entry)) - `(read-time ,ftime) - `(subscribe-all ,subscribe-all))) - (gnus-sync-lesync-install-group-entry - (cdr (assq 'id entry))))))) - (gnus-sync-lesync-groups-builder (nth 1 gnus-sync-backend))))) - - ((stringp gnus-sync-backend) - ;; read data here... - (if (or debug-on-error debug-on-quit) - (load gnus-sync-backend nil t) - (condition-case var - (load gnus-sync-backend nil t) - (error - (error "Error in %s: %s" gnus-sync-backend (cadr var))))) - (let ((valid-count 0) - invalid-groups) - (dolist (node gnus-sync-newsrc-loader) - (if (gnus-gethash (car node) gnus-newsrc-hashtb) - (progn - (incf valid-count) - (loop for store in (cdr node) - do (setf (nth (car store) - (assoc (car node) gnus-newsrc-alist)) - (cdr store)))) - (push (car node) invalid-groups))) - (gnus-message - 7 - "gnus-sync-read: loaded %d groups (out of %d) from %s" - valid-count (length gnus-sync-newsrc-loader) - gnus-sync-backend) - (when invalid-groups - (gnus-message - 7 - "gnus-sync-read: skipped %d groups (out of %d) from %s" - (length invalid-groups) - (length gnus-sync-newsrc-loader) - gnus-sync-backend) - (gnus-message 9 "gnus-sync-read: skipped groups: %s" - (mapconcat 'identity invalid-groups ", "))))) - (nil)) - - (gnus-message 9 "gnus-sync-read: remaking the newsrc hashtable") - (gnus-make-hashtable-from-newsrc-alist))) - -;;;###autoload -(defun gnus-sync-initialize () -"Initialize the Gnus sync facility." - (interactive) - (gnus-message 5 "Initializing the sync facility") - (gnus-sync-install-hooks)) - -;;;###autoload -(defun gnus-sync-install-hooks () - "Install the sync hooks." - (interactive) - ;; (add-hook 'gnus-get-new-news-hook 'gnus-sync-read) - ;; (add-hook 'gnus-read-newsrc-el-hook 'gnus-sync-read) - (add-hook 'gnus-save-newsrc-hook 'gnus-sync-save)) - -(defun gnus-sync-unload-hook () - "Uninstall the sync hooks." - (interactive) - (remove-hook 'gnus-save-newsrc-hook 'gnus-sync-save)) - -(add-hook 'gnus-sync-unload-hook 'gnus-sync-unload-hook) - -(when gnus-sync-backend (gnus-sync-initialize)) - -(provide 'gnus-sync) - -;;; gnus-sync.el ends here diff --git a/lisp/gnus/messcompat.el b/lisp/gnus/messcompat.el deleted file mode 100644 index f54dabd53a..0000000000 --- a/lisp/gnus/messcompat.el +++ /dev/null @@ -1,91 +0,0 @@ -;;; messcompat.el --- making message mode compatible with mail mode - -;; Copyright (C) 1996-2017 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: mail, news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Commentary: - -;; This file tries to provide backward compatibility with sendmail.el -;; for Message mode. It should be used by simply adding -;; -;; (require 'messcompat) -;; -;; to the .emacs file. Loading it after Message mode has been -;; loaded will have no effect. - -;;; Code: - -(require 'sendmail) - -(defvar message-from-style mail-from-style - "*Specifies how \"From\" headers look. - -If nil, they contain just the return address like: - king@grassland.com -If `parens', they look like: - king@grassland.com (Elvis Parsley) -If `angles', they look like: - Elvis Parsley - -Otherwise, most addresses look like `angles', but they look like -`parens' if `angles' would need quoting and `parens' would not.") - -(defvar message-interactive mail-interactive - "Non-nil means when sending a message wait for and display errors. -nil means let mailer mail back a message to report errors.") - -(defvar message-setup-hook mail-setup-hook - "Normal hook, run each time a new outgoing message is initialized. -The function `message-setup' runs this hook.") - -(if (boundp 'mail-mode-hook) - (defvar message-mode-hook mail-mode-hook - "Hook run in message mode buffers.")) - -(defvar message-indentation-spaces mail-indentation-spaces - "*Number of spaces to insert at the beginning of each cited line. -Used by `message-yank-original' via `message-yank-cite'.") - -(defvar message-signature mail-signature - "*String to be inserted at the end of the message buffer. -If t, the `message-signature-file' file will be inserted instead. -If a function, the result from the function will be used instead. -If a form, the result from the form will be used instead.") - -;; Deleted the autoload cookie because this crashes in loaddefs.el. -(defvar message-signature-file mail-signature-file - "*File containing the text inserted at end of the message buffer.") - -(defvar message-default-headers mail-default-headers - "*A string containing header lines to be inserted in outgoing messages. -It is inserted before you edit the message, so you can edit or delete -these lines.") - -(defvar message-send-hook mail-send-hook - "Hook run before sending messages.") - -(defvar message-send-mail-function send-mail-function - "Function to call to send the current buffer as mail. -The headers should be delimited by a line whose contents match the -variable `mail-header-separator'.") - -(provide 'messcompat) - -;;; messcompat.el ends here diff --git a/lisp/nxml/nxml-glyph.el b/lisp/nxml/nxml-glyph.el deleted file mode 100644 index a0e9b6f355..0000000000 --- a/lisp/nxml/nxml-glyph.el +++ /dev/null @@ -1,423 +0,0 @@ -;;; nxml-glyph.el --- glyph-handling for nxml-mode - -;; Copyright (C) 2003, 2007-2017 Free Software Foundation, Inc. - -;; Author: James Clark -;; Keywords: wp, hypermedia, languages, XML - -;; 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: - -;; The entry point to this file is `nxml-glyph-display-string'. -;; The current implementation is heuristic due to a lack of -;; Emacs primitives necessary to implement it properly. The user -;; can tweak the heuristics using `nxml-glyph-set-functions'. - -;;; Code: - -(defconst nxml-ascii-glyph-set - [(#x0020 . #x007E)]) - -(defconst nxml-latin1-glyph-set - [(#x0020 . #x007E) - (#x00A0 . #x00FF)]) - -;; These were generated by using nxml-insert-target-repertoire-glyph-set -;; on the TARGET[123] files in -;; http://www.cl.cam.ac.uk/~mgk25/download/ucs-fonts.tar.gz - -(defconst nxml-misc-fixed-1-glyph-set - [(#x0020 . #x007E) - (#x00A0 . #x00FF) - (#x0100 . #x017F) - #x018F #x0192 - (#x0218 . #x021B) - #x0259 - (#x02C6 . #x02C7) - (#x02D8 . #x02DD) - (#x0374 . #x0375) - #x037A #x037E - (#x0384 . #x038A) - #x038C - (#x038E . #x03A1) - (#x03A3 . #x03CE) - (#x0401 . #x040C) - (#x040E . #x044F) - (#x0451 . #x045C) - (#x045E . #x045F) - (#x0490 . #x0491) - (#x05D0 . #x05EA) - (#x1E02 . #x1E03) - (#x1E0A . #x1E0B) - (#x1E1E . #x1E1F) - (#x1E40 . #x1E41) - (#x1E56 . #x1E57) - (#x1E60 . #x1E61) - (#x1E6A . #x1E6B) - (#x1E80 . #x1E85) - (#x1EF2 . #x1EF3) - (#x2010 . #x2022) - #x2026 #x2030 - (#x2039 . #x203A) - #x20AC #x2116 #x2122 #x2126 - (#x215B . #x215E) - (#x2190 . #x2193) - #x2260 - (#x2264 . #x2265) - (#x23BA . #x23BD) - (#x2409 . #x240D) - #x2424 #x2500 #x2502 #x250C #x2510 #x2514 #x2518 #x251C #x2524 #x252C #x2534 #x253C #x2592 #x25C6 #x266A #xFFFD] - "Glyph set for TARGET1 glyph repertoire of misc-fixed-* font. -This repertoire is supported for the bold and oblique fonts.") - -(defconst nxml-misc-fixed-2-glyph-set - [(#x0020 . #x007E) - (#x00A0 . #x00FF) - (#x0100 . #x017F) - #x018F #x0192 - (#x01FA . #x01FF) - (#x0218 . #x021B) - #x0259 - (#x02C6 . #x02C7) - #x02C9 - (#x02D8 . #x02DD) - (#x0300 . #x0311) - (#x0374 . #x0375) - #x037A #x037E - (#x0384 . #x038A) - #x038C - (#x038E . #x03A1) - (#x03A3 . #x03CE) - #x03D1 - (#x03D5 . #x03D6) - #x03F1 - (#x0401 . #x040C) - (#x040E . #x044F) - (#x0451 . #x045C) - (#x045E . #x045F) - (#x0490 . #x0491) - (#x05D0 . #x05EA) - (#x1E02 . #x1E03) - (#x1E0A . #x1E0B) - (#x1E1E . #x1E1F) - (#x1E40 . #x1E41) - (#x1E56 . #x1E57) - (#x1E60 . #x1E61) - (#x1E6A . #x1E6B) - (#x1E80 . #x1E85) - (#x1EF2 . #x1EF3) - (#x2010 . #x2022) - #x2026 #x2030 - (#x2032 . #x2034) - (#x2039 . #x203A) - #x203C #x203E #x2044 - (#x2070 . #x2071) - (#x2074 . #x208E) - (#x20A3 . #x20A4) - #x20A7 #x20AC - (#x20D0 . #x20D7) - #x2102 #x2105 #x2113 - (#x2115 . #x2116) - #x211A #x211D #x2122 #x2124 #x2126 #x212E - (#x215B . #x215E) - (#x2190 . #x2195) - (#x21A4 . #x21A8) - (#x21D0 . #x21D5) - (#x2200 . #x2209) - (#x220B . #x220C) - #x220F - (#x2211 . #x2213) - #x2215 - (#x2218 . #x221A) - (#x221D . #x221F) - #x2221 - (#x2224 . #x222B) - #x222E #x223C #x2243 #x2245 - (#x2248 . #x2249) - #x2259 - (#x225F . #x2262) - (#x2264 . #x2265) - (#x226A . #x226B) - (#x2282 . #x228B) - #x2295 #x2297 - (#x22A4 . #x22A7) - (#x22C2 . #x22C3) - #x22C5 #x2300 #x2302 - (#x2308 . #x230B) - #x2310 - (#x2320 . #x2321) - (#x2329 . #x232A) - (#x23BA . #x23BD) - (#x2409 . #x240D) - #x2424 #x2500 #x2502 #x250C #x2510 #x2514 #x2518 #x251C #x2524 #x252C #x2534 #x253C - (#x254C . #x2573) - (#x2580 . #x25A1) - (#x25AA . #x25AC) - (#x25B2 . #x25B3) - #x25BA #x25BC #x25C4 #x25C6 - (#x25CA . #x25CB) - #x25CF - (#x25D8 . #x25D9) - #x25E6 - (#x263A . #x263C) - #x2640 #x2642 #x2660 #x2663 - (#x2665 . #x2666) - (#x266A . #x266B) - (#xFB01 . #xFB02) - #xFFFD] - "Glyph set for TARGET2 glyph repertoire of the misc-fixed-* fonts. -This repertoire is supported for the following fonts: -5x7.bdf 5x8.bdf 6x9.bdf 6x10.bdf 6x12.bdf 7x13.bdf 7x14.bdf clR6x12.bdf") - -(defconst nxml-misc-fixed-3-glyph-set - [(#x0020 . #x007E) - (#x00A0 . #x00FF) - (#x0100 . #x01FF) - (#x0200 . #x0220) - (#x0222 . #x0233) - (#x0250 . #x02AD) - (#x02B0 . #x02EE) - (#x0300 . #x034F) - (#x0360 . #x036F) - (#x0374 . #x0375) - #x037A #x037E - (#x0384 . #x038A) - #x038C - (#x038E . #x03A1) - (#x03A3 . #x03CE) - (#x03D0 . #x03F6) - (#x0400 . #x0486) - (#x0488 . #x04CE) - (#x04D0 . #x04F5) - (#x04F8 . #x04F9) - (#x0500 . #x050F) - (#x0531 . #x0556) - (#x0559 . #x055F) - (#x0561 . #x0587) - (#x0589 . #x058A) - (#x05B0 . #x05B9) - (#x05BB . #x05C4) - (#x05D0 . #x05EA) - (#x05F0 . #x05F4) - (#x10D0 . #x10F8) - #x10FB - (#x1E00 . #x1E9B) - (#x1EA0 . #x1EF9) - (#x1F00 . #x1F15) - (#x1F18 . #x1F1D) - (#x1F20 . #x1F45) - (#x1F48 . #x1F4D) - (#x1F50 . #x1F57) - #x1F59 #x1F5B #x1F5D - (#x1F5F . #x1F7D) - (#x1F80 . #x1FB4) - (#x1FB6 . #x1FC4) - (#x1FC6 . #x1FD3) - (#x1FD6 . #x1FDB) - (#x1FDD . #x1FEF) - (#x1FF2 . #x1FF4) - (#x1FF6 . #x1FFE) - (#x2000 . #x200A) - (#x2010 . #x2027) - (#x202F . #x2052) - #x2057 - (#x205F . #x2063) - (#x2070 . #x2071) - (#x2074 . #x208E) - (#x20A0 . #x20B1) - (#x20D0 . #x20EA) - (#x2100 . #x213A) - (#x213D . #x214B) - (#x2153 . #x2183) - (#x2190 . #x21FF) - (#x2200 . #x22FF) - (#x2300 . #x23CE) - (#x2400 . #x2426) - (#x2440 . #x244A) - (#x2500 . #x25FF) - (#x2600 . #x2613) - (#x2616 . #x2617) - (#x2619 . #x267D) - (#x2680 . #x2689) - (#x27E6 . #x27EB) - (#x27F5 . #x27FF) - (#x2A00 . #x2A06) - #x2A1D #x2A3F #x303F - (#xFB00 . #xFB06) - (#xFB13 . #xFB17) - (#xFB1D . #xFB36) - (#xFB38 . #xFB3C) - #xFB3E - (#xFB40 . #xFB41) - (#xFB43 . #xFB44) - (#xFB46 . #xFB4F) - (#xFE20 . #xFE23) - (#xFF61 . #xFF9F) - #xFFFD] - "Glyph set for TARGET3 glyph repertoire of the misc-fixed-* fonts. -This repertoire is supported for the following fonts: -6x13.bdf 8x13.bdf 9x15.bdf 9x18.bdf 10x20.bdf") - -(defconst nxml-wgl4-glyph-set - [(#x0020 . #x007E) - (#x00A0 . #x017F) - #x0192 - (#x01FA . #x01FF) - (#x02C6 . #x02C7) - #x02C9 - (#x02D8 . #x02DB) - #x02DD - (#x0384 . #x038A) - #x038C - (#x038E . #x03A1) - (#x03A3 . #x03CE) - (#x0401 . #x040C) - (#x040E . #x044F) - (#x0451 . #x045C) - (#x045E . #x045F) - (#x0490 . #x0491) - (#x1E80 . #x1E85) - (#x1EF2 . #x1EF3) - (#x2013 . #x2015) - (#x2017 . #x201E) - (#x2020 . #x2022) - #x2026 #x2030 - (#x2032 . #x2033) - (#x2039 . #x203A) - #x203C #x203E #x2044 #x207F - (#x20A3 . #x20A4) - #x20A7 #x20AC #x2105 #x2113 #x2116 #x2122 #x2126 #x212E - (#x215B . #x215E) - (#x2190 . #x2195) - #x21A8 #x2202 #x2206 #x220F - (#x2211 . #x2212) - #x2215 - (#x2219 . #x221A) - (#x221E . #x221F) - #x2229 #x222B #x2248 - (#x2260 . #x2261) - (#x2264 . #x2265) - #x2302 #x2310 - (#x2320 . #x2321) - #x2500 #x2502 #x250C #x2510 #x2514 #x2518 #x251C #x2524 - #x252C #x2534 #x253C - (#x2550 . #x256C) - #x2580 #x2584 #x2588 #x258C - (#x2590 . #x2593) - (#x25A0 . #x25A1) - (#x25AA . #x25AC) - #x25B2 #x25BA #x25BC #x25C4 - (#x25CA . #x25CB) - #x25CF - (#x25D8 . #x25D9) - #x25E6 - (#x263A . #x263C) - #x2640 #x2642 #x2660 #x2663 - (#x2665 . #x2666) - (#x266A . #x266B) - (#xFB01 . #xFB02)] - "Glyph set corresponding to Windows Glyph List 4.") - -(defvar nxml-glyph-set-functions nil - "Abnormal hook for determining the set of glyphs in a face. -Each function in this hook is called in turn, unless one of them -returns non-nil. Each function is called with a single argument -FACE. If it can determine the set of glyphs representable by -FACE, it must set the variable `nxml-glyph-set' and return -non-nil. Otherwise, it must return nil. - -The constants `nxml-ascii-glyph-set', `nxml-latin1-glyph-set', -`nxml-misc-fixed-1-glyph-set', `nxml-misc-fixed-2-glyph-set', -`nxml-misc-fixed-3-glyph-set' and `nxml-wgl4-glyph-set' are -predefined for use by `nxml-glyph-set-functions'.") - -(define-obsolete-variable-alias 'nxml-glyph-set-hook - 'nxml-glyph-set-functions "24.3") - -(defvar nxml-glyph-set nil - "Used by `nxml-glyph-set-functions' to return set of glyphs in a FACE. -This should dynamically bound by any function that runs -`nxml-glyph-set-functions'. The value must be either nil representing an -empty set or a vector. Each member of the vector is either a single -integer or a cons (FIRST . LAST) representing the range of integers -from FIRST to LAST. An integer represents a glyph with that Unicode -code-point. The vector must be ordered.") - -(defun nxml-x-set-glyph-set (face) - (setq nxml-glyph-set - (if (equal (face-attribute face :family) "misc-fixed") - nxml-misc-fixed-3-glyph-set - nxml-wgl4-glyph-set))) - -(defun nxml-w32-set-glyph-set (face) - (setq nxml-glyph-set nxml-wgl4-glyph-set)) - -(defun nxml-window-system-set-glyph-set (face) - (setq nxml-glyph-set nxml-latin1-glyph-set)) - -(defun nxml-terminal-set-glyph-set (face) - (setq nxml-glyph-set nxml-ascii-glyph-set)) - -(add-hook 'nxml-glyph-set-functions - (or (cdr (assq window-system - '((x . nxml-x-set-glyph-set) - (w32 . nxml-w32-set-glyph-set) - (nil . nxml-terminal-set-glyph-set)))) - 'nxml-window-system-set-glyph-set) - t) - -;;;###autoload -(defun nxml-glyph-display-string (n face) - "Return a string that can display a glyph for Unicode code-point N. -FACE gives the face that will be used for displaying the string. -Return nil if the face cannot display a glyph for N." - (let ((nxml-glyph-set nil)) - (run-hook-with-args-until-success 'nxml-glyph-set-functions face) - (and nxml-glyph-set - (nxml-glyph-set-contains-p n nxml-glyph-set) - (let ((ch (decode-char 'ucs n))) - (and ch (string ch)))))) - -(defun nxml-glyph-set-contains-p (n v) - (let ((start 0) - (end (length v)) - found mid mid-val mid-start-val mid-end-val) - (while (> end start) - (setq mid (+ start - (/ (- end start) 2))) - (setq mid-val (aref v mid)) - (if (consp mid-val) - (setq mid-start-val (car mid-val) - mid-end-val (cdr mid-val)) - (setq mid-start-val mid-val - mid-end-val mid-val)) - (cond ((and (<= mid-start-val n) - (<= n mid-end-val)) - (setq found t) - (setq start end)) - ((< n mid-start-val) - (setq end mid)) - (t - (setq start - (if (eq start mid) - end - mid))))) - found)) - -(provide 'nxml-glyph) - -;;; nxml-glyph.el ends here diff --git a/lisp/nxml/nxml-uchnm.el b/lisp/nxml/nxml-uchnm.el deleted file mode 100644 index 06e03688e0..0000000000 --- a/lisp/nxml/nxml-uchnm.el +++ /dev/null @@ -1,251 +0,0 @@ -;;; nxml-uchnm.el --- support for Unicode standard cha names in nxml-mode - -;; Copyright (C) 2003, 2007-2017 Free Software Foundation, Inc. - -;; Author: James Clark -;; Keywords: wp, hypermedia, languages, XML - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Commentary: - -;; This enables the use of the character names defined in the Unicode -;; Standard. The use of the names can be controlled on a per-block -;; basis, so as both to reduce memory usage and loading time, -;; and to make completion work better. - -;;; Code: - -(require 'nxml-mode) - -(defconst nxml-unicode-blocks - '(("Basic Latin" #x0000 #x007F) - ("Latin-1 Supplement" #x0080 #x00FF) - ("Latin Extended-A" #x0100 #x017F) - ("Latin Extended-B" #x0180 #x024F) - ("IPA Extensions" #x0250 #x02AF) - ("Spacing Modifier Letters" #x02B0 #x02FF) - ("Combining Diacritical Marks" #x0300 #x036F) - ("Greek and Coptic" #x0370 #x03FF) - ("Cyrillic" #x0400 #x04FF) - ("Cyrillic Supplementary" #x0500 #x052F) - ("Armenian" #x0530 #x058F) - ("Hebrew" #x0590 #x05FF) - ("Arabic" #x0600 #x06FF) - ("Syriac" #x0700 #x074F) - ("Thaana" #x0780 #x07BF) - ("Devanagari" #x0900 #x097F) - ("Bengali" #x0980 #x09FF) - ("Gurmukhi" #x0A00 #x0A7F) - ("Gujarati" #x0A80 #x0AFF) - ("Oriya" #x0B00 #x0B7F) - ("Tamil" #x0B80 #x0BFF) - ("Telugu" #x0C00 #x0C7F) - ("Kannada" #x0C80 #x0CFF) - ("Malayalam" #x0D00 #x0D7F) - ("Sinhala" #x0D80 #x0DFF) - ("Thai" #x0E00 #x0E7F) - ("Lao" #x0E80 #x0EFF) - ("Tibetan" #x0F00 #x0FFF) - ("Myanmar" #x1000 #x109F) - ("Georgian" #x10A0 #x10FF) - ("Hangul Jamo" #x1100 #x11FF) - ("Ethiopic" #x1200 #x137F) - ("Cherokee" #x13A0 #x13FF) - ("Unified Canadian Aboriginal Syllabics" #x1400 #x167F) - ("Ogham" #x1680 #x169F) - ("Runic" #x16A0 #x16FF) - ("Tagalog" #x1700 #x171F) - ("Hanunoo" #x1720 #x173F) - ("Buhid" #x1740 #x175F) - ("Tagbanwa" #x1760 #x177F) - ("Khmer" #x1780 #x17FF) - ("Mongolian" #x1800 #x18AF) - ("Latin Extended Additional" #x1E00 #x1EFF) - ("Greek Extended" #x1F00 #x1FFF) - ("General Punctuation" #x2000 #x206F) - ("Superscripts and Subscripts" #x2070 #x209F) - ("Currency Symbols" #x20A0 #x20CF) - ("Combining Diacritical Marks for Symbols" #x20D0 #x20FF) - ("Letterlike Symbols" #x2100 #x214F) - ("Number Forms" #x2150 #x218F) - ("Arrows" #x2190 #x21FF) - ("Mathematical Operators" #x2200 #x22FF) - ("Miscellaneous Technical" #x2300 #x23FF) - ("Control Pictures" #x2400 #x243F) - ("Optical Character Recognition" #x2440 #x245F) - ("Enclosed Alphanumerics" #x2460 #x24FF) - ("Box Drawing" #x2500 #x257F) - ("Block Elements" #x2580 #x259F) - ("Geometric Shapes" #x25A0 #x25FF) - ("Miscellaneous Symbols" #x2600 #x26FF) - ("Dingbats" #x2700 #x27BF) - ("Miscellaneous Mathematical Symbols-A" #x27C0 #x27EF) - ("Supplemental Arrows-A" #x27F0 #x27FF) - ("Braille Patterns" #x2800 #x28FF) - ("Supplemental Arrows-B" #x2900 #x297F) - ("Miscellaneous Mathematical Symbols-B" #x2980 #x29FF) - ("Supplemental Mathematical Operators" #x2A00 #x2AFF) - ("CJK Radicals Supplement" #x2E80 #x2EFF) - ("Kangxi Radicals" #x2F00 #x2FDF) - ("Ideographic Description Characters" #x2FF0 #x2FFF) - ("CJK Symbols and Punctuation" #x3000 #x303F) - ("Hiragana" #x3040 #x309F) - ("Katakana" #x30A0 #x30FF) - ("Bopomofo" #x3100 #x312F) - ("Hangul Compatibility Jamo" #x3130 #x318F) - ("Kanbun" #x3190 #x319F) - ("Bopomofo Extended" #x31A0 #x31BF) - ("Katakana Phonetic Extensions" #x31F0 #x31FF) - ("Enclosed CJK Letters and Months" #x3200 #x32FF) - ("CJK Compatibility" #x3300 #x33FF) - ("CJK Unified Ideographs Extension A" #x3400 #x4DBF) - ;;("CJK Unified Ideographs" #x4E00 #x9FFF) - ("Yi Syllables" #xA000 #xA48F) - ("Yi Radicals" #xA490 #xA4CF) - ;;("Hangul Syllables" #xAC00 #xD7AF) - ;;("High Surrogates" #xD800 #xDB7F) - ;;("High Private Use Surrogates" #xDB80 #xDBFF) - ;;("Low Surrogates" #xDC00 #xDFFF) - ;;("Private Use Area" #xE000 #xF8FF) - ;;("CJK Compatibility Ideographs" #xF900 #xFAFF) - ("Alphabetic Presentation Forms" #xFB00 #xFB4F) - ("Arabic Presentation Forms-A" #xFB50 #xFDFF) - ("Variation Selectors" #xFE00 #xFE0F) - ("Combining Half Marks" #xFE20 #xFE2F) - ("CJK Compatibility Forms" #xFE30 #xFE4F) - ("Small Form Variants" #xFE50 #xFE6F) - ("Arabic Presentation Forms-B" #xFE70 #xFEFF) - ("Halfwidth and Fullwidth Forms" #xFF00 #xFFEF) - ("Specials" #xFFF0 #xFFFF) - ("Old Italic" #x10300 #x1032F) - ("Gothic" #x10330 #x1034F) - ("Deseret" #x10400 #x1044F) - ("Byzantine Musical Symbols" #x1D000 #x1D0FF) - ("Musical Symbols" #x1D100 #x1D1FF) - ("Mathematical Alphanumeric Symbols" #x1D400 #x1D7FF) - ;;("CJK Unified Ideographs Extension B" #x20000 #x2A6DF) - ;;("CJK Compatibility Ideographs Supplement" #x2F800 #x2FA1F) - ("Tags" #xE0000 #xE007F) - ;;("Supplementary Private Use Area-A" #xF0000 #xFFFFF) - ;;("Supplementary Private Use Area-B" #x100000 #x10FFFF) - ) - "List of Unicode blocks. -For each block there is a list (NAME FIRST LAST), where -NAME is a string giving the official name of the block, -FIRST is the first code-point and LAST is the last code-point. -Blocks containing only characters with algorithmic names or no names -are omitted.") - -(defun nxml-unicode-block-char-name-set (name) - "Return a symbol for a block whose official Unicode name is NAME. -The symbol is generated by downcasing and replacing each space -by a hyphen." - (intern (replace-regexp-in-string " " "-" (downcase name)))) - -;; This is intended to be a superset of the coverage -;; of existing standard entity sets. -(defvar nxml-enabled-unicode-blocks-default - '(basic-latin - latin-1-supplement - latin-extended-a - latin-extended-b - ipa-extensions - spacing-modifier-letters - combining-diacritical-marks - greek-and-coptic - cyrillic - general-punctuation - superscripts-and-subscripts - currency-symbols - combining-diacritical-marks-for-symbols - letterlike-symbols - number-forms - arrows - mathematical-operators - miscellaneous-technical - control-pictures - optical-character-recognition - enclosed-alphanumerics - box-drawing - block-elements - geometric-shapes - miscellaneous-symbols - dingbats - miscellaneous-mathematical-symbols-a - supplemental-arrows-a - supplemental-arrows-b - miscellaneous-mathematical-symbols-b - supplemental-mathematical-operators - cjk-symbols-and-punctuation - alphabetic-presentation-forms - variation-selectors - small-form-variants - specials - mathematical-alphanumeric-symbols) - "Default value for `nxml-enabled-unicode-blocks'.") - -(mapc (lambda (block) - (nxml-autoload-char-name-set - (nxml-unicode-block-char-name-set (car block)) - (expand-file-name - (format "nxml/%05X-%05X" - (nth 1 block) - (nth 2 block)) - data-directory))) - nxml-unicode-blocks) - -;; Internal flag to control whether customize reloads the character tables. -;; Should be set the first time the -(defvar nxml-internal-unicode-char-name-sets-enabled nil) - -(defcustom nxml-enabled-unicode-blocks nxml-enabled-unicode-blocks-default - "List of Unicode blocks for which Unicode character names are enabled. -Each block is identified by a symbol derived from the name -of the block by downcasing and replacing each space by a hyphen." - :group 'nxml - :set (lambda (sym value) - (set-default 'nxml-enabled-unicode-blocks value) - (when nxml-internal-unicode-char-name-sets-enabled - (nxml-enable-unicode-char-name-sets))) - :type (cons 'set - (mapcar (lambda (block) - `(const :tag ,(format "%s (%04X-%04X)" - (nth 0 block) - (nth 1 block) - (nth 2 block)) - ,(nxml-unicode-block-char-name-set - (nth 0 block)))) - nxml-unicode-blocks))) - -;;;###autoload -(defun nxml-enable-unicode-char-name-sets () - "Enable the use of Unicode standard names for characters. -The Unicode blocks for which names are enabled is controlled by -the variable `nxml-enabled-unicode-blocks'." - (interactive) - (setq nxml-internal-unicode-char-name-sets-enabled t) - (mapc (lambda (block) - (nxml-disable-char-name-set - (nxml-unicode-block-char-name-set (car block)))) - nxml-unicode-blocks) - (mapc (lambda (nameset) - (nxml-enable-char-name-set nameset)) - nxml-enabled-unicode-blocks)) - -(provide 'nxml-uchnm) - -;;; nxml-uchnm.el ends here diff --git a/lisp/obsolete/awk-mode.el b/lisp/obsolete/awk-mode.el deleted file mode 100644 index f42043b8fb..0000000000 --- a/lisp/obsolete/awk-mode.el +++ /dev/null @@ -1,124 +0,0 @@ -;;; awk-mode.el --- AWK code editing commands for Emacs - -;; Copyright (C) 1988, 1994, 1996, 2000-2017 Free Software Foundation, -;; Inc. - -;; Maintainer: emacs-devel@gnu.org -;; Keywords: unix, languages -;; Obsolete-since: 22.1 - -;; 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: - -;; Sets up C-mode with support for awk-style #-comments and a lightly -;; hacked syntax table. - -;;; Code: - -(defvar awk-mode-syntax-table - (let ((st (make-syntax-table))) - (modify-syntax-entry ?\\ "\\" st) - (modify-syntax-entry ?\n "> " st) - (modify-syntax-entry ?\f "> " st) - (modify-syntax-entry ?\# "< " st) - ;; / can delimit regexes or be a division operator. We assume that it is - ;; more commonly used for regexes and fix the remaining cases with - ;; `font-lock-syntactic-keywords'. - (modify-syntax-entry ?/ "\"" st) - (modify-syntax-entry ?* "." st) - (modify-syntax-entry ?+ "." st) - (modify-syntax-entry ?- "." st) - (modify-syntax-entry ?= "." st) - (modify-syntax-entry ?% "." st) - (modify-syntax-entry ?< "." st) - (modify-syntax-entry ?> "." st) - (modify-syntax-entry ?& "." st) - (modify-syntax-entry ?| "." st) - (modify-syntax-entry ?_ "_" st) - (modify-syntax-entry ?\' "\"" st) - st) - "Syntax table in use in `awk-mode' buffers.") - -;; Regexps written with help from Peter Galbraith . -(defconst awk-font-lock-keywords - (eval-when-compile - (list - ;; - ;; Function names. - '("^[ \t]*\\(function\\)\\>[ \t]*\\(\\sw+\\)?" - (1 font-lock-keyword-face) (2 font-lock-function-name-face nil t)) - ;; - ;; Variable names. - (cons (regexp-opt - '("ARGC" "ARGIND" "ARGV" "CONVFMT" "ENVIRON" "ERRNO" - "FIELDWIDTHS" "FILENAME" "FNR" "FS" "IGNORECASE" "NF" "NR" - "OFMT" "OFS" "ORS" "RLENGTH" "RS" "RSTART" "SUBSEP") 'words) - 'font-lock-variable-name-face) - ;; - ;; Keywords. - (regexp-opt - '("BEGIN" "END" "break" "continue" "delete" "do" "exit" "else" "for" - "getline" "if" "next" "print" "printf" "return" "while") 'words) - ;; - ;; Builtins. - (list (regexp-opt - '("atan2" "close" "cos" "ctime" "exp" "gsub" "index" "int" - "length" "log" "match" "rand" "sin" "split" "sprintf" - "sqrt" "srand" "sub" "substr" "system" "time" - "tolower" "toupper") 'words) - 1 'font-lock-builtin-face) - ;; - ;; Operators. Is this too much? - (cons (regexp-opt '("&&" "||" "<=" "<" ">=" ">" "==" "!=" "!~" "~")) - 'font-lock-constant-face) - )) - "Default expressions to highlight in AWK mode.") - -(require 'syntax) - -(defconst awk-font-lock-syntactic-keywords - ;; `/' is mostly used for /.../ regular expressions, but is also - ;; used as a division operator. Distinguishing between the two is - ;; a pain in the youknowwhat. - ;; '(("\\(^\\|[<=>-+*%/!^,~(?:|&]\\)\\s-*\\(/\\)\\([^/\n\\]\\|\\\\.\\)*\\(/\\)" - ;; (2 "\"") (4 "\""))) - '(("[^<=>-+*%/!^,~(?:|& \t\n\f]\\s-*\\(/\\)" - (1 (unless (nth 3 (syntax-ppss (match-beginning 1))) ".")))) - "Syntactic keywords for `awk-mode'.") - -;; No longer autoloaded since it might clobber the autoload directive in CC Mode. -(define-derived-mode awk-mode c-mode "AWK" - "Major mode for editing AWK code. -This is much like C mode except for the syntax of comments. Its keymap -inherits from C mode's and it has the same variables for customizing -indentation. It has its own abbrev table and its own syntax table. - -Turning on AWK mode runs `awk-mode-hook'." - (set (make-local-variable 'paragraph-start) (concat "$\\|" page-delimiter)) - (set (make-local-variable 'paragraph-separate) paragraph-start) - (set (make-local-variable 'comment-start) "# ") - (set (make-local-variable 'comment-end) "") - (set (make-local-variable 'comment-start-skip) "#+ *") - (setq font-lock-defaults '(awk-font-lock-keywords - nil nil ((?_ . "w")) nil - (parse-sexp-lookup-properties . t) - (font-lock-syntactic-keywords - . awk-font-lock-syntactic-keywords)))) - -(provide 'awk-mode) - -;;; awk-mode.el ends here diff --git a/lisp/obsolete/iso-acc.el b/lisp/obsolete/iso-acc.el deleted file mode 100644 index a18d4e543f..0000000000 --- a/lisp/obsolete/iso-acc.el +++ /dev/null @@ -1,489 +0,0 @@ -;;; iso-acc.el --- minor mode providing electric accent keys - -;; Copyright (C) 1993-1994, 1996, 2001-2017 Free Software Foundation, -;; Inc. - -;; Author: Johan Vromans -;; Maintainer: emacs-devel@gnu.org -;; Keywords: i18n -;; Obsolete-since: 22.1 - -;; 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: - -;; Function `iso-accents-mode' activates a minor mode in which -;; typewriter "dead keys" are emulated. The purpose of this emulation -;; is to provide a simple means for inserting accented characters -;; according to the ISO-8859-1...3 character sets. -;; -;; In `iso-accents-mode', pseudo accent characters are used to -;; introduce accented keys. The pseudo-accent characters are: -;; -;; ' (minute) -> acute accent -;; ` (backtick) -> grave accent -;; " (second) -> diaeresis -;; ^ (caret) -> circumflex -;; ~ (tilde) -> tilde over the character -;; / (slash) -> slash through the character. -;; Also: /A is A-with-ring and /E is AE ligature. -;; These two are enabled only if you set iso-accents-enable -;; to include them: -;; . (period) -> dot over the character (some languages only) -;; , (cedilla) -> cedilla under the character (some languages only) -;; -;; The action taken depends on the key that follows the pseudo accent. -;; In general: -;; -;; pseudo-accent + appropriate letter -> accented letter -;; pseudo-accent + space -> pseudo-accent (except comma and period) -;; pseudo-accent + pseudo-accent -> accent (if available) -;; pseudo-accent + other -> pseudo-accent + other -;; -;; If the pseudo-accent is followed by anything else than a -;; self-insert-command, the dead-key code is terminated, the -;; pseudo-accent inserted ‘as is’ and the bell is rung to signal this. -;; -;; Function `iso-accents-mode' can be used to enable the iso accents -;; minor mode, or disable it. - -;; If you want only some of these characters to serve as accents, -;; add a language to `iso-languages' which specifies the accent characters -;; that you want, then select the language with `iso-accents-customize'. - -;;; Code: - -(provide 'iso-acc) - -(defgroup iso-acc nil - "Minor mode providing electric accent keys." - :prefix "iso-accents-" - :group 'i18n) - -(defcustom iso-accents-insert-offset nonascii-insert-offset - "Offset added by ISO Accents mode to character codes 0200 and above." - :type 'integer - :group 'iso-acc) - -(defvar iso-languages - '(("catalan" - ;; Note this includes some extra characters used in Spanish, - ;; on the idea that someone who uses Catalan is likely to use Spanish - ;; as well. - (?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332) - (?a . ?\341) (?e . ?\351) (?i . ?\355) (?o . ?\363) (?u . ?\372) - (?\ . ?')) - (?` (?A . ?\300) (?E . ?\310) (?O . ?\322) - (?a . ?\340) (?e . ?\350) (?o . ?\362) - (?\ . ?`)) - (?\" (?I . ?\317) (?U . ?\334) (?i . ?\357) (?u . ?\374) - (?\ . ?\")) - (?~ (?C . ?\307) (?N . ?\321) (?c . ?\347) (?n . ?\361) - (?> . ?\273) (?< . ?\253) (?! . ?\241) (?? . ?\277) - (?\ . ?\~))) - - ("esperanto" - (?^ (?H . ?\246) (?J . ?\254) (?h . ?\266) (?j . ?\274) (?C . ?\306) - (?G . ?\330) (?S . ?\336) (?c . ?\346) (?g . ?\370) (?s . ?\376) - (?^ . ?^) (?\ . ?^)) - (?~ (?U . ?\335) (?u . ?\375) (?\ . ?~))) - - ("french" - (?' (?E . ?\311) (?C . ?\307) (?e . ?\351) (?c . ?\347) - (?\ . ?')) - (?` (?A . ?\300) (?E . ?\310) (?U . ?\331) - (?a . ?\340) (?e . ?\350) (?u . ?\371) - (?\ . ?`)) - (?^ (?A . ?\302) (?E . ?\312) (?I . ?\316) (?O . ?\324) (?U . ?\333) - (?a . ?\342) (?e . ?\352) (?i . ?\356) (?o . ?\364) (?u . ?\373) - (?\ . ?^)) - (?\" (?E . ?\313) (?I . ?\317) - (?e . ?\353) (?i . ?\357) - (?\ . ?\")) - (?~ (?< . ?\253) (?> . ?\273) (?C . ?\307) (?c . ?\347) - (?\ . ?~)) - (?, (?C . ?\307) (?c . ?\347) (?\ . ?\,))) - - ("german" - (?\" (?A . ?\304) (?O . ?\326) (?U . ?\334) - (?a . ?\344) (?o . ?\366) (?u . ?\374) (?s . ?\337) (?\ . ?\"))) - - ("irish" - (?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332) - (?a . ?\341) (?e . ?\351) (?i . ?\355) (?o . ?\363) (?u . ?\372) - (?\ . ?'))) - - ("portuguese" - (?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332) - (?C . ?\307) (?a . ?\341) (?e . ?\351) (?i . ?\355) (?o . ?\363) - (?u . ?\372) (?c . ?\347) - (?\ . ?')) - (?` (?A . ?\300) (?a . ?\340) - (?\ . ?`)) - (?^ (?A . ?\302) (?E . ?\312) (?O . ?\324) - (?a . ?\342) (?e . ?\352) (?o . ?\364) - (?\ . ?^)) - (?\" (?U . ?\334) (?u . ?\374) - (?\ . ?\")) - (?~ (?A . ?\303) (?O . ?\325) (?a . ?\343) (?o . ?\365) - (?C . ?\307) (?N . ?\321) (?c . ?\347) (?n . ?\361) - (?\ . ?~)) - (?, (?c . ?\347) (?C . ?\307) (?, . ?,))) - - ("spanish" - (?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332) - (?a . ?\341) (?e . ?\351) (?i . ?\355) (?o . ?\363) (?u . ?\372) - (?\ . ?')) - (?\" (?U . ?\334) (?u . ?\374) (?\ . ?\")) - (?\~ (?N . ?\321) (?n . ?\361) (?> . ?\273) (?< . ?\253) (?! . ?\241) - (?? . ?\277) (?\ . ?\~))) - - ("latin-1" - (?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332) - (?Y . ?\335) (?a . ?\341) (?e . ?\351) (?i . ?\355) (?o . ?\363) - (?u . ?\372) (?y . ?\375) (?' . ?\264) - (?\ . ?')) - (?` (?A . ?\300) (?E . ?\310) (?I . ?\314) (?O . ?\322) (?U . ?\331) - (?a . ?\340) (?e . ?\350) (?i . ?\354) (?o . ?\362) (?u . ?\371) - (?` . ?`) (?\ . ?`)) - (?^ (?A . ?\302) (?E . ?\312) (?I . ?\316) (?O . ?\324) (?U . ?\333) - (?a . ?\342) (?e . ?\352) (?i . ?\356) (?o . ?\364) (?u . ?\373) - (?^ . ?^) (?\ . ?^)) - (?\" (?A . ?\304) (?E . ?\313) (?I . ?\317) (?O . ?\326) (?U . ?\334) - (?a . ?\344) (?e . ?\353) (?i . ?\357) (?o . ?\366) (?s . ?\337) - (?u . ?\374) (?y . ?\377) - (?\" . ?\250) (?\ . ?\")) - (?~ (?A . ?\303) (?C . ?\307) (?D . ?\320) (?N . ?\321) (?O . ?\325) - (?T . ?\336) (?a . ?\343) (?c . ?\347) (?d . ?\360) (?n . ?\361) - (?o . ?\365) (?t . ?\376) - (?> . ?\273) (?< . ?\253) (?! . ?\241) (?? . ?\277) - (?\~ . ?\270) (?\ . ?~)) - (?/ (?A . ?\305) (?E . ?\306) (?O . ?\330) (?a . ?\345) (?e . ?\346) - (?o . ?\370) - (?/ . ?\260) (?\ . ?/))) - - ("latin-2" latin-iso8859-2 - (?' (?A . ?\301) (?C . ?\306) (?D . ?\320) (?E . ?\311) (?I . ?\315) - (?L . ?\305) (?N . ?\321) (?O . ?\323) (?R . ?\300) (?S . ?\246) - (?U . ?\332) (?Y . ?\335) (?Z . ?\254) - (?a . ?\341) (?c . ?\346) (?d . ?\360) (?e . ?\351) (?i . ?\355) - (?l . ?\345) (?n . ?\361) (?o . ?\363) (?r . ?\340) (?s . ?\266) - (?u . ?\372) (?y . ?\375) (?z . ?\274) - (?' . ?\264) (?\ . ?')) - (?` (?A . ?\241) (?C . ?\307) (?E . ?\312) (?L . ?\243) (?S . ?\252) - (?T . ?\336) (?Z . ?\257) - (?a . ?\261) (?l . ?\263) (?c . ?\347) (?e . ?\352) (?s . ?\272) - (?t . ?\376) (?z . ?\277) - (?` . ?\252) - (?. . ?\377) (?\ . ?`)) - (?^ (?A . ?\302) (?I . ?\316) (?O . ?\324) - (?a . ?\342) (?i . ?\356) (?o . ?\364) - (?^ . ?^) ; no special code? - (?\ . ?^)) - (?\" (?A . ?\304) (?E . ?\313) (?O . ?\326) (?U . ?\334) - (?a . ?\344) (?e . ?\353) (?o . ?\366) (?s . ?\337) (?u . ?\374) - (?\" . ?\250) - (?\ . ?\")) - (?~ (?A . ?\303) (?C . ?\310) (?D . ?\317) (?L . ?\245) (?N . ?\322) - (?O . ?\325) (?R . ?\330) (?S . ?\251) (?T . ?\253) (?U . ?\333) - (?Z . ?\256) - (?a . ?\343) (?c . ?\350) (?d . ?\357) (?l . ?\265) (?n . ?\362) - (?o . ?\365) (?r . ?\370) (?s . ?\271) (?t . ?\273) (?u . ?\373) - (?z . ?\276) - (?v . ?\242) ; v accent - (?\~ . ?\242) ; v accent - (?\. . ?\270) ; cedilla accent - (?\ . ?~))) - - ("latin-3" latin-iso8859-3 - (?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332) - (?a . ?\341) (?e . ?\351) (?i . ?\355) (?o . ?\363) (?u . ?\372) - (?' . ?\264) (?\ . ?')) - (?` (?A . ?\300) (?E . ?\310) (?I . ?\314) (?O . ?\322) (?U . ?\331) - (?a . ?\340) (?e . ?\350) (?i . ?\354) (?o . ?\362) (?u . ?\371) - (?` . ?`) (?\ . ?`)) - (?^ (?A . ?\302) (?C . ?\306) (?E . ?\312) (?G . ?\330) (?H . ?\246) - (?I . ?\316) (?J . ?\254) (?O . ?\324) (?S . ?\336) (?U . ?\333) - (?a . ?\342) (?c . ?\346) (?e . ?\352) (?g . ?\370) (?h . ?\266) - (?i . ?\356) (?j . ?\274) (?o . ?\364) (?s . ?\376) (?u . ?\373) - (?^ . ?^) (?\ . ?^)) - (?\" (?A . ?\304) (?E . ?\313) (?I . ?\317) (?O . ?\326) (?U . ?\334) - (?a . ?\344) (?e . ?\353) (?i . ?\357) (?o . ?\366) (?u . ?\374) - (?s . ?\337) - (?\" . ?\250) (?\ . ?\")) - (?~ (?A . ?\303) (?C . ?\307) (?D . ?\320) (?N . ?\321) (?O . ?\325) - (?a . ?\343) (?c . ?\347) (?d . ?\360) (?n . ?\361) (?o . ?\365) - (?$ . ?\245) (?S . ?\252) (?s . ?\272) (?G . ?\253) (?g . ?\273) - (?U . ?\335) (?u . ?\375) (?` . ?\242) - (?~ . ?\270) (?\ . ?~)) - (?/ (?C . ?\305) (?G . ?\325) (?H . ?\241) (?I . ?\251) (?Z . ?\257) - (?c . ?\345) (?g . ?\365) (?h . ?\261) (?i . ?\271) (?z . ?\277) - (?r . ?\256) - (?. . ?\377) (?# . ?\243) (?$ . ?\244) - (?/ . ?\260) (?\ . ?/)) - (?. (?C . ?\305) (?G . ?\325) (?I . ?\251) (?Z . ?\257) - (?c . ?\345) (?g . ?\365) (?z . ?\277)))) - "List of language-specific customizations for the ISO Accents mode. - -Each element of the list is of the form - - (LANGUAGE [CHARSET] - (PSEUDO-ACCENT MAPPINGS) - (PSEUDO-ACCENT MAPPINGS) - ...) - -LANGUAGE is a string naming the language. -CHARSET (which may be omitted) is the symbol name - of the character set used in this language. - If CHARSET is omitted, latin-iso8859-1 is the default. -PSEUDO-ACCENT is a char specifying an accent key. -MAPPINGS are cons cells of the form (CHAR . ISO-CHAR). - -The net effect is that the key sequence PSEUDO-ACCENT CHAR is mapped -to ISO-CHAR on input.") - -(defvar iso-language nil - "Language for which ISO Accents mode is currently customized. -Change it with the `iso-accents-customize' function.") - -(defvar iso-accents-list nil - "Association list for ISO accent combinations, for the chosen language.") - -(defcustom iso-accents-mode nil - "Non-nil enables ISO Accents mode. -Setting this variable makes it local to the current buffer. -See the function `iso-accents-mode'." - :type 'boolean - :group 'iso-acc) -(make-variable-buffer-local 'iso-accents-mode) - -(defcustom iso-accents-enable '(?' ?` ?^ ?\" ?~ ?/) - "List of accent keys that become prefixes in ISO Accents mode. -The default is (?\\=' ?\\=` ?^ ?\" ?~ ?/), which contains all the supported -accent keys. If you set this variable to a list in which some of those -characters are missing, the missing ones do not act as accents. - -Note that if you specify a language with `iso-accents-customize', -that can also turn off certain prefixes (whichever ones are not needed in -the language you choose)." - :type '(repeat character) - :group 'iso-acc) - -(defun iso-accents-accent-key (prompt) - "Modify the following character by adding an accent to it." - ;; Pick up the accent character. - (if (and iso-accents-mode - (memq last-input-event iso-accents-enable)) - (iso-accents-compose prompt) - (vector last-input-event))) - - -;; The iso-accents-compose function is called deep inside Emacs' read -;; key sequence machinery, so the call to read-event below actually -;; recurses into that machinery. Doing that does not cause any -;; problem on its own, but read-event will have marked the window's -;; display matrix to be accurate -- which is broken by the subsequent -;; call to delete-region. Therefore, we must call force-window-update -;; after delete-region to explicitly clear the accurate state of the -;; window's display matrix. - -(defun iso-accents-compose (prompt) - (let* ((first-char last-input-event) - (list (assq first-char iso-accents-list)) - ;; Wait for the second key and look up the combination. - (second-char (if (or prompt - (not (eq (key-binding "a") - 'self-insert-command)) - ;; Not at start of a key sequence. - (> (length (this-single-command-keys)) 1) - ;; Called from anything but the command loop. - this-command) - (progn - (message "%s%c" - (or prompt "Compose with ") - first-char) - (read-event)) - (insert first-char) - (prog1 (read-event) - (delete-region (1- (point)) (point)) - ;; Display is no longer up-to-date. - (force-window-update (selected-window))))) - (entry (cdr (assq second-char list)))) - (if entry - ;; Found it: return the mapped char - (vector - (if (and enable-multibyte-characters - (>= entry ?\200)) - (+ iso-accents-insert-offset entry) - entry)) - ;; Otherwise, advance and schedule the second key for execution. - (push second-char unread-command-events) - (vector first-char)))) - -;; It is a matter of taste if you want the minor mode indicated -;; in the mode line... -;; If so, uncomment the next four lines. -;; (or (assq 'iso-accents-mode minor-mode-alist) -;; (setq minor-mode-alist -;; (append minor-mode-alist -;; '((iso-accents-mode " ISO-Acc"))))) - -;;;###autoload -(defun iso-accents-mode (&optional arg) - "Toggle ISO Accents mode, in which accents modify the following letter. -This permits easy insertion of accented characters according to ISO-8859-1. -When Iso-accents mode is enabled, accent character keys -\(\\=`, \\=', \", ^, / and ~) do not self-insert; instead, they modify the following -letter key so that it inserts an ISO accented letter. - -You can customize ISO Accents mode to a particular language -with the command `iso-accents-customize'. - -Special combinations: ~c gives a c with cedilla, -~d gives an Icelandic eth (d with dash). -~t gives an Icelandic thorn. -\"s gives German sharp s. -/a gives a with ring. -/e gives an a-e ligature. -~< and ~> give guillemots. -~! gives an inverted exclamation mark. -~? gives an inverted question mark. - -With an argument, a positive argument enables ISO Accents mode, -and a negative argument disables it." - - (interactive "P") - - (if (if arg - ;; Negative arg means switch it off. - (<= (prefix-numeric-value arg) 0) - ;; No arg means toggle. - iso-accents-mode) - (setq iso-accents-mode nil) - - ;; Enable electric accents. - (setq iso-accents-mode t))) - -(defun iso-accents-customize (language) - "Customize the ISO accents machinery for a particular language. -It selects the customization based on the specifications in the -`iso-languages' variable." - (interactive (list (completing-read "Language: " iso-languages nil t))) - (let ((table (cdr (assoc language iso-languages))) - all-accents tail) - (if (not table) - (error "Unknown language `%s'" language) - (setq iso-accents-insert-offset (- (make-char (if (symbolp (car table)) - (car table) - 'latin-iso8859-1)) - 128)) - (if (symbolp (car table)) - (setq table (cdr table))) - (setq iso-language language - iso-accents-list table) - (if key-translation-map - (substitute-key-definition - 'iso-accents-accent-key nil key-translation-map) - (setq key-translation-map (make-sparse-keymap))) - ;; Set up translations for all the characters that are used as - ;; accent prefixes in this language. - (setq tail iso-accents-list) - (while tail - (define-key key-translation-map (vector (car (car tail))) - 'iso-accents-accent-key) - (setq tail (cdr tail)))))) - -(defun iso-accentuate (start end) - "Convert two-character sequences in region into accented characters. -Noninteractively, this operates on text from START to END. -This uses the same conversion that ISO Accents mode uses for type-in." - (interactive "r") - (save-excursion - (save-restriction - (narrow-to-region start end) - (goto-char start) - (forward-char 1) - (let (entry) - (while (< (point) end) - (if (and (memq (preceding-char) iso-accents-enable) - (setq entry (cdr (assq (following-char) (assq (preceding-char) iso-accents-list))))) - (progn - (forward-char -1) - (delete-char 2) - (insert entry) - (setq end (1- end))) - (forward-char 1))))))) - -(defun iso-accent-rassoc-unit (value alist) - (let (elt acc) - (while (and alist (not elt)) - (setq acc (car (car alist)) - elt (car (rassq value (cdr (car alist)))) - alist (cdr alist))) - (if elt - (cons acc elt)))) - -(defun iso-unaccentuate (start end) - "Convert accented characters in the region into two-character sequences. -Noninteractively, this operates on text from START to END. -This uses the opposite of the conversion done by ISO Accents mode for type-in." - (interactive "r") - (save-excursion - (save-restriction - (narrow-to-region start end) - (goto-char start) - (let (entry) - (while (< (point) end) - (if (and (> (following-char) 127) - (setq entry (iso-accent-rassoc-unit (following-char) - iso-accents-list))) - (progn - (delete-char 1) - (insert (car entry) (cdr entry)) - (setq end (1+ end))) - (forward-char 1))))))) - -(defun iso-deaccentuate (start end) - "Convert accented characters in the region into unaccented characters. -Noninteractively, this operates on text from START to END." - (interactive "r") - (save-excursion - (save-restriction - (narrow-to-region start end) - (goto-char start) - (let (entry) - (while (< (point) end) - (if (and (> (following-char) 127) - (setq entry (iso-accent-rassoc-unit (following-char) - iso-accents-list))) - (progn - (delete-char 1) - (insert (cdr entry))) - (forward-char 1))))))) - -;; Set up the default settings. -(iso-accents-customize "latin-1") - -;; Use Iso-Accents mode in the minibuffer -;; if it was in use in the previous buffer. -(defun iso-acc-minibuf-setup () - (setq iso-accents-mode - (with-current-buffer (window-buffer minibuffer-scroll-window) - iso-accents-mode))) - -(add-hook 'minibuffer-setup-hook 'iso-acc-minibuf-setup) - -;;; iso-acc.el ends here diff --git a/lisp/obsolete/iso-insert.el b/lisp/obsolete/iso-insert.el deleted file mode 100644 index 1075ae03e0..0000000000 --- a/lisp/obsolete/iso-insert.el +++ /dev/null @@ -1,630 +0,0 @@ -;;; iso-insert.el --- insert functions for ISO 8859/1 - -;; Copyright (C) 1987, 1994, 2001-2017 Free Software Foundation, Inc. - -;; Author: Howard Gayle -;; Maintainer: emacs-devel@gnu.org -;; Keywords: i18n -;; Obsolete-since: 22.1 - -;; 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: - -;; Provides keys for inserting ISO Latin-1 characters. They use the -;; prefix key C-x 8. Type C-x 8 C-h for a list. - -;;; Code: - -(defun insert-no-break-space () - (interactive "*") - (insert ?\ ) -) - -(defun insert-inverted-exclamation-mark () - (interactive "*") - (insert ?\¡) -) - -(defun insert-cent-sign () - (interactive "*") - (insert ?\¢) -) - -(defun insert-pound-sign () - (interactive "*") - (insert ?\£) -) - -(defun insert-general-currency-sign () - (interactive "*") - (insert ?\¤) -) - -(defun insert-yen-sign () - (interactive "*") - (insert ?\¥) -) - -(defun insert-broken-vertical-line () - (interactive "*") - (insert ?\¦) -) - -(defun insert-section-sign () - (interactive "*") - (insert ?\§) -) - -(defun insert-diaeresis () - (interactive "*") - (insert ?\¨) -) - -(defun insert-copyright-sign () - (interactive "*") - (insert ?\©) -) - -(defun insert-ordinal-indicator-feminine () - (interactive "*") - (insert ?\ª) -) - -(defun insert-angle-quotation-mark-left () - (interactive "*") - (insert ?\«) -) - -(defun insert-not-sign () - (interactive "*") - (insert ?\¬) -) - -(defun insert-soft-hyphen () - (interactive "*") - (insert ?\­) -) - -(defun insert-registered-sign () - (interactive "*") - (insert ?\®) -) - -(defun insert-macron () - (interactive "*") - (insert ?\¯) -) - -(defun insert-degree-sign () - (interactive "*") - (insert ?\°) -) - -(defun insert-plus-or-minus-sign () - (interactive "*") - (insert ?\±) -) - -(defun insert-superscript-two () - (interactive "*") - (insert ?\²) -) - -(defun insert-superscript-three () - (interactive "*") - (insert ?\³) -) - -(defun insert-acute-accent () - (interactive "*") - (insert ?\´) -) - -(defun insert-micro-sign () - (interactive "*") - (insert ?\µ) -) - -(defun insert-pilcrow () - (interactive "*") - (insert ?\¶) -) - -(defun insert-middle-dot () - (interactive "*") - (insert ?\·) -) - -(defun insert-cedilla () - (interactive "*") - (insert ?\¸) -) - -(defun insert-superscript-one () - (interactive "*") - (insert ?\¹) -) - -(defun insert-ordinal-indicator-masculine () - (interactive "*") - (insert ?\º) -) - -(defun insert-angle-quotation-mark-right () - (interactive "*") - (insert ?\») -) - -(defun insert-fraction-one-quarter () - (interactive "*") - (insert ?\¼) -) - -(defun insert-fraction-one-half () - (interactive "*") - (insert ?\½) -) - -(defun insert-fraction-three-quarters () - (interactive "*") - (insert ?\¾) -) - -(defun insert-inverted-question-mark () - (interactive "*") - (insert ?\¿) -) - -(defun insert-A-grave () - (interactive "*") - (insert ?\À) -) - -(defun insert-A-acute () - (interactive "*") - (insert ?\Á) -) - -(defun insert-A-circumflex () - (interactive "*") - (insert ?\Â) -) - -(defun insert-A-tilde () - (interactive "*") - (insert ?\Ã) -) - -(defun insert-A-umlaut () - (interactive "*") - (insert ?\Ä) -) - -(defun insert-A-ring () - (interactive "*") - (insert ?\Å) -) - -(defun insert-AE () - (interactive "*") - (insert ?\Æ) -) - -(defun insert-C-cedilla () - (interactive "*") - (insert ?\Ç) -) - -(defun insert-E-grave () - (interactive "*") - (insert ?\È) -) - -(defun insert-E-acute () - (interactive "*") - (insert ?\É) -) - -(defun insert-E-circumflex () - (interactive "*") - (insert ?\Ê) -) - -(defun insert-E-umlaut () - (interactive "*") - (insert ?\Ë) -) - -(defun insert-I-grave () - (interactive "*") - (insert ?\Ì) -) - -(defun insert-I-acute () - (interactive "*") - (insert ?\Í) -) - -(defun insert-I-circumflex () - (interactive "*") - (insert ?\Î) -) - -(defun insert-I-umlaut () - (interactive "*") - (insert ?\Ï) -) - -(defun insert-D-stroke () - (interactive "*") - (insert ?\Ð) -) - -(defun insert-N-tilde () - (interactive "*") - (insert ?\Ñ) -) - -(defun insert-O-grave () - (interactive "*") - (insert ?\Ò) -) - -(defun insert-O-acute () - (interactive "*") - (insert ?\Ó) -) - -(defun insert-O-circumflex () - (interactive "*") - (insert ?\Ô) -) - -(defun insert-O-tilde () - (interactive "*") - (insert ?\Õ) -) - -(defun insert-O-umlaut () - (interactive "*") - (insert ?\Ö) -) - -(defun insert-multiplication-sign () - (interactive "*") - (insert ?\×) -) - -(defun insert-O-slash () - (interactive "*") - (insert ?\Ø) -) - -(defun insert-U-grave () - (interactive "*") - (insert ?\Ù) -) - -(defun insert-U-acute () - (interactive "*") - (insert ?\Ú) -) - -(defun insert-U-circumflex () - (interactive "*") - (insert ?\Û) -) - -(defun insert-U-umlaut () - (interactive "*") - (insert ?\Ü) -) - -(defun insert-Y-acute () - (interactive "*") - (insert ?\Ý) -) - -(defun insert-THORN () - (interactive "*") - (insert ?\Þ) -) - -(defun insert-ss () - (interactive "*") - (insert ?\ß) -) - -(defun insert-a-grave () - (interactive "*") - (insert ?\à) -) - -(defun insert-a-acute () - (interactive "*") - (insert ?\á) -) - -(defun insert-a-circumflex () - (interactive "*") - (insert ?\â) -) - -(defun insert-a-tilde () - (interactive "*") - (insert ?\ã) -) - -(defun insert-a-umlaut () - (interactive "*") - (insert ?\ä) -) - -(defun insert-a-ring () - (interactive "*") - (insert ?\å) -) - -(defun insert-ae () - (interactive "*") - (insert ?\æ) -) - -(defun insert-c-cedilla () - (interactive "*") - (insert ?\ç) -) - -(defun insert-e-grave () - (interactive "*") - (insert ?\è) -) - -(defun insert-e-acute () - (interactive "*") - (insert ?\é) -) - -(defun insert-e-circumflex () - (interactive "*") - (insert ?\ê) -) - -(defun insert-e-umlaut () - (interactive "*") - (insert ?\ë) -) - -(defun insert-i-grave () - (interactive "*") - (insert ?\ì) -) - -(defun insert-i-acute () - (interactive "*") - (insert ?\í) -) - -(defun insert-i-circumflex () - (interactive "*") - (insert ?\î) -) - -(defun insert-i-umlaut () - (interactive "*") - (insert ?\ï) -) - -(defun insert-d-stroke () - (interactive "*") - (insert ?\ð) -) - -(defun insert-n-tilde () - (interactive "*") - (insert ?\ñ) -) - -(defun insert-o-grave () - (interactive "*") - (insert ?\ò) -) - -(defun insert-o-acute () - (interactive "*") - (insert ?\ó) -) - -(defun insert-o-circumflex () - (interactive "*") - (insert ?\ô) -) - -(defun insert-o-tilde () - (interactive "*") - (insert ?\õ) -) - -(defun insert-o-umlaut () - (interactive "*") - (insert ?\ö) -) - -(defun insert-division-sign () - (interactive "*") - (insert ?\÷) -) - -(defun insert-o-slash () - (interactive "*") - (insert ?\ø) -) - -(defun insert-u-grave () - (interactive "*") - (insert ?\ù) -) - -(defun insert-u-acute () - (interactive "*") - (insert ?\ú) -) - -(defun insert-u-circumflex () - (interactive "*") - (insert ?\û) -) - -(defun insert-u-umlaut () - (interactive "*") - (insert ?\ü) -) - -(defun insert-y-acute () - (interactive "*") - (insert ?\ý) -) - -(defun insert-thorn () - (interactive "*") - (insert ?\þ) -) - -(defun insert-y-umlaut () - (interactive "*") - (insert ?\ÿ) -) - -(defvar 8859-1-map nil "Keymap for ISO 8859/1 character insertion.") -(if 8859-1-map nil - (setq 8859-1-map (make-keymap)) - (define-key 8859-1-map " " 'insert-no-break-space) - (define-key 8859-1-map "!" 'insert-inverted-exclamation-mark) - (define-key 8859-1-map "\"" (make-sparse-keymap)) - (define-key 8859-1-map "\"\"" 'insert-diaeresis) - (define-key 8859-1-map "\"A" 'insert-A-umlaut) - (define-key 8859-1-map "\"E" 'insert-E-umlaut) - (define-key 8859-1-map "\"I" 'insert-I-umlaut) - (define-key 8859-1-map "\"O" 'insert-O-umlaut) - (define-key 8859-1-map "\"U" 'insert-U-umlaut) - (define-key 8859-1-map "\"a" 'insert-a-umlaut) - (define-key 8859-1-map "\"e" 'insert-e-umlaut) - (define-key 8859-1-map "\"i" 'insert-i-umlaut) - (define-key 8859-1-map "\"o" 'insert-o-umlaut) - (define-key 8859-1-map "\"u" 'insert-u-umlaut) - (define-key 8859-1-map "\"y" 'insert-y-umlaut) - (define-key 8859-1-map "'" (make-sparse-keymap)) - (define-key 8859-1-map "''" 'insert-acute-accent) - (define-key 8859-1-map "'A" 'insert-A-acute) - (define-key 8859-1-map "'E" 'insert-E-acute) - (define-key 8859-1-map "'I" 'insert-I-acute) - (define-key 8859-1-map "'O" 'insert-O-acute) - (define-key 8859-1-map "'U" 'insert-U-acute) - (define-key 8859-1-map "'Y" 'insert-Y-acute) - (define-key 8859-1-map "'a" 'insert-a-acute) - (define-key 8859-1-map "'e" 'insert-e-acute) - (define-key 8859-1-map "'i" 'insert-i-acute) - (define-key 8859-1-map "'o" 'insert-o-acute) - (define-key 8859-1-map "'u" 'insert-u-acute) - (define-key 8859-1-map "'y" 'insert-y-acute) - (define-key 8859-1-map "$" 'insert-general-currency-sign) - (define-key 8859-1-map "+" 'insert-plus-or-minus-sign) - (define-key 8859-1-map "," (make-sparse-keymap)) - (define-key 8859-1-map ",," 'insert-cedilla) - (define-key 8859-1-map ",C" 'insert-C-cedilla) - (define-key 8859-1-map ",c" 'insert-c-cedilla) - (define-key 8859-1-map "-" 'insert-soft-hyphen) - (define-key 8859-1-map "." 'insert-middle-dot) - (define-key 8859-1-map "/" (make-sparse-keymap)) - (define-key 8859-1-map "//" 'insert-division-sign) - (define-key 8859-1-map "/O" 'insert-O-slash) - (define-key 8859-1-map "/o" 'insert-o-slash) - (define-key 8859-1-map "1" (make-sparse-keymap)) - (define-key 8859-1-map "1/" (make-sparse-keymap)) - (define-key 8859-1-map "1/2" 'insert-fraction-one-half) - (define-key 8859-1-map "1/4" 'insert-fraction-one-quarter) - (define-key 8859-1-map "3" (make-sparse-keymap)) - (define-key 8859-1-map "3/" (make-sparse-keymap)) - (define-key 8859-1-map "3/4" 'insert-fraction-three-quarters) - (define-key 8859-1-map "<" 'insert-angle-quotation-mark-left) - (define-key 8859-1-map "=" 'insert-macron) - (define-key 8859-1-map ">" 'insert-angle-quotation-mark-right) - (define-key 8859-1-map "?" 'insert-inverted-question-mark) - (define-key 8859-1-map "A" 'insert-A-ring) - (define-key 8859-1-map "E" 'insert-AE) - (define-key 8859-1-map "C" 'insert-copyright-sign) - (define-key 8859-1-map "D" 'insert-D-stroke) - (define-key 8859-1-map "L" 'insert-pound-sign) - (define-key 8859-1-map "P" 'insert-pilcrow) - (define-key 8859-1-map "R" 'insert-registered-sign) - (define-key 8859-1-map "S" 'insert-section-sign) - (define-key 8859-1-map "T" 'insert-THORN) - (define-key 8859-1-map "Y" 'insert-yen-sign) - (define-key 8859-1-map "^" (make-sparse-keymap)) - (define-key 8859-1-map "^1" 'insert-superscript-one) - (define-key 8859-1-map "^2" 'insert-superscript-two) - (define-key 8859-1-map "^3" 'insert-superscript-three) - (define-key 8859-1-map "^A" 'insert-A-circumflex) - (define-key 8859-1-map "^E" 'insert-E-circumflex) - (define-key 8859-1-map "^I" 'insert-I-circumflex) - (define-key 8859-1-map "^O" 'insert-O-circumflex) - (define-key 8859-1-map "^U" 'insert-U-circumflex) - (define-key 8859-1-map "^a" 'insert-a-circumflex) - (define-key 8859-1-map "^e" 'insert-e-circumflex) - (define-key 8859-1-map "^i" 'insert-i-circumflex) - (define-key 8859-1-map "^o" 'insert-o-circumflex) - (define-key 8859-1-map "^u" 'insert-u-circumflex) - (define-key 8859-1-map "_" (make-sparse-keymap)) - (define-key 8859-1-map "_a" 'insert-ordinal-indicator-feminine) - (define-key 8859-1-map "_o" 'insert-ordinal-indicator-masculine) - (define-key 8859-1-map "`" (make-sparse-keymap)) - (define-key 8859-1-map "`A" 'insert-A-grave) - (define-key 8859-1-map "`E" 'insert-E-grave) - (define-key 8859-1-map "`I" 'insert-I-grave) - (define-key 8859-1-map "`O" 'insert-O-grave) - (define-key 8859-1-map "`U" 'insert-U-grave) - (define-key 8859-1-map "`a" 'insert-a-grave) - (define-key 8859-1-map "`e" 'insert-e-grave) - (define-key 8859-1-map "`i" 'insert-i-grave) - (define-key 8859-1-map "`o" 'insert-o-grave) - (define-key 8859-1-map "`u" 'insert-u-grave) - (define-key 8859-1-map "a" 'insert-a-ring) - (define-key 8859-1-map "e" 'insert-ae) - (define-key 8859-1-map "c" 'insert-cent-sign) - (define-key 8859-1-map "d" 'insert-d-stroke) - (define-key 8859-1-map "o" 'insert-degree-sign) - (define-key 8859-1-map "s" 'insert-ss) - (define-key 8859-1-map "t" 'insert-thorn) - (define-key 8859-1-map "u" 'insert-micro-sign) - (define-key 8859-1-map "x" 'insert-multiplication-sign) - (define-key 8859-1-map "|" 'insert-broken-vertical-line) - (define-key 8859-1-map "~" (make-sparse-keymap)) - (define-key 8859-1-map "~A" 'insert-A-tilde) - (define-key 8859-1-map "~N" 'insert-N-tilde) - (define-key 8859-1-map "~O" 'insert-O-tilde) - (define-key 8859-1-map "~a" 'insert-a-tilde) - (define-key 8859-1-map "~n" 'insert-n-tilde) - (define-key 8859-1-map "~o" 'insert-o-tilde) - (define-key 8859-1-map "~~" 'insert-not-sign) - (if (not (lookup-key global-map "\C-x8")) - (define-key global-map "\C-x8" 8859-1-map)) -) -(defalias '8859-1-map 8859-1-map) - -(provide 'iso-insert) - -;;; iso-insert.el ends here diff --git a/lisp/obsolete/iso-swed.el b/lisp/obsolete/iso-swed.el deleted file mode 100644 index e3231be20e..0000000000 --- a/lisp/obsolete/iso-swed.el +++ /dev/null @@ -1,150 +0,0 @@ -;;; iso-swed.el --- set up char tables for ISO 8859/1 for Swedish/Finnish ttys - -;; Copyright (C) 1987, 2001-2017 Free Software Foundation, Inc. - -;; Author: Howard Gayle -;; Maintainer: emacs-devel@gnu.org -;; Keywords: i18n -;; Obsolete-since: 22.1 - -;; 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: - -;; Written by Howard Gayle. See case-table.el for details. - -;;; Code: - -;; This code sets up to display ISO 8859/1 characters on -;; terminals that have ASCII in the G0 set and a Swedish/Finnish -;; version of ISO 646 in the G1 set. The G1 set differs from -;; ASCII as follows: -;; -;; ASCII G1 -;; $ general currency sign -;; @ capital E with acute accent -;; [ capital A with diaeresis or umlaut mark -;; \ capital O with diaeresis or umlaut mark -;; ] capital A with ring -;; ^ capital U with diaeresis or umlaut mark -;; ` small e with acute accent -;; { small a with diaeresis or umlaut mark -;; | small o with diaeresis or umlaut mark -;; } small a with ring -;; ~ small u with diaeresis or umlaut mark - -(require 'disp-table) - -(standard-display-ascii 160 "{_}") ; NBSP (no-break space) -(standard-display-ascii 161 "{!}") ; inverted exclamation mark -(standard-display-ascii 162 "{c}") ; cent sign -(standard-display-ascii 163 "{GBP}") ; pound sign -(standard-display-g1 164 ?$) ; general currency sign -(standard-display-ascii 165 "{JPY}") ; yen sign -(standard-display-ascii 166 "{|}") ; broken vertical line -(standard-display-ascii 167 "{S}") ; section sign -(standard-display-ascii 168 "{\"}") ; diaeresis -(standard-display-ascii 169 "{C}") ; copyright sign -(standard-display-ascii 170 "{_a}") ; ordinal indicator, feminine -(standard-display-ascii 171 "{<<}") ; left angle quotation mark -(standard-display-ascii 172 "{~}") ; not sign -(standard-display-ascii 173 "{-}") ; soft hyphen -(standard-display-ascii 174 "{R}") ; registered sign -(standard-display-ascii 175 "{=}") ; macron -(standard-display-ascii 176 "{o}") ; degree sign -(standard-display-ascii 177 "{+-}") ; plus or minus sign -(standard-display-ascii 178 "{2}") ; superscript two -(standard-display-ascii 179 "{3}") ; superscript three -(standard-display-ascii 180 "{'}") ; acute accent -(standard-display-ascii 181 "{u}") ; micro sign -(standard-display-ascii 182 "{P}") ; pilcrow -(standard-display-ascii 183 "{.}") ; middle dot -(standard-display-ascii 184 "{,}") ; cedilla -(standard-display-ascii 185 "{1}") ; superscript one -(standard-display-ascii 186 "{_o}") ; ordinal indicator, masculine -(standard-display-ascii 187 "{>>}") ; right angle quotation mark -(standard-display-ascii 188 "{1/4}") ; fraction one-quarter -(standard-display-ascii 189 "{1/2}") ; fraction one-half -(standard-display-ascii 190 "{3/4}") ; fraction three-quarters -(standard-display-ascii 191 "{?}") ; inverted question mark -(standard-display-ascii 192 "{`A}") ; A with grave accent -(standard-display-ascii 193 "{'A}") ; A with acute accent -(standard-display-ascii 194 "{^A}") ; A with circumflex accent -(standard-display-ascii 195 "{~A}") ; A with tilde -(standard-display-g1 196 ?[) ; A with diaeresis or umlaut mark -(standard-display-g1 197 ?]) ; A with ring -(standard-display-ascii 198 "{AE}") ; AE diphthong -(standard-display-ascii 199 "{,C}") ; C with cedilla -(standard-display-ascii 200 "{`E}") ; E with grave accent -(standard-display-g1 201 ?@) ; E with acute accent -(standard-display-ascii 202 "{^E}") ; E with circumflex accent -(standard-display-ascii 203 "{\"E}") ; E with diaeresis or umlaut mark -(standard-display-ascii 204 "{`I}") ; I with grave accent -(standard-display-ascii 205 "{'I}") ; I with acute accent -(standard-display-ascii 206 "{^I}") ; I with circumflex accent -(standard-display-ascii 207 "{\"I}") ; I with diaeresis or umlaut mark -(standard-display-ascii 208 "{-D}") ; D with stroke, Icelandic eth -(standard-display-ascii 209 "{~N}") ; N with tilde -(standard-display-ascii 210 "{`O}") ; O with grave accent -(standard-display-ascii 211 "{'O}") ; O with acute accent -(standard-display-ascii 212 "{^O}") ; O with circumflex accent -(standard-display-ascii 213 "{~O}") ; O with tilde -(standard-display-g1 214 ?\\) ; O with diaeresis or umlaut mark -(standard-display-ascii 215 "{x}") ; multiplication sign -(standard-display-ascii 216 "{/O}") ; O with slash -(standard-display-ascii 217 "{`U}") ; U with grave accent -(standard-display-ascii 218 "{'U}") ; U with acute accent -(standard-display-ascii 219 "{^U}") ; U with circumflex accent -(standard-display-g1 220 ?^) ; U with diaeresis or umlaut mark -(standard-display-ascii 221 "{'Y}") ; Y with acute accent -(standard-display-ascii 222 "{TH}") ; capital thorn, Icelandic -(standard-display-ascii 223 "{ss}") ; small sharp s, German -(standard-display-ascii 224 "{`a}") ; a with grave accent -(standard-display-ascii 225 "{'a}") ; a with acute accent -(standard-display-ascii 226 "{^a}") ; a with circumflex accent -(standard-display-ascii 227 "{~a}") ; a with tilde -(standard-display-g1 228 ?{) ; a with diaeresis or umlaut mark -(standard-display-g1 229 ?}) ; a with ring -(standard-display-ascii 230 "{ae}") ; ae diphthong -(standard-display-ascii 231 "{,c}") ; c with cedilla -(standard-display-ascii 232 "{`e}") ; e with grave accent -(standard-display-g1 233 ?`) ; e with acute accent -(standard-display-ascii 234 "{^e}") ; e with circumflex accent -(standard-display-ascii 235 "{\"e}") ; e with diaeresis or umlaut mark -(standard-display-ascii 236 "{`i}") ; i with grave accent -(standard-display-ascii 237 "{'i}") ; i with acute accent -(standard-display-ascii 238 "{^i}") ; i with circumflex accent -(standard-display-ascii 239 "{\"i}") ; i with diaeresis or umlaut mark -(standard-display-ascii 240 "{-d}") ; d with stroke, Icelandic eth -(standard-display-ascii 241 "{~n}") ; n with tilde -(standard-display-ascii 242 "{`o}") ; o with grave accent -(standard-display-ascii 243 "{'o}") ; o with acute accent -(standard-display-ascii 244 "{^o}") ; o with circumflex accent -(standard-display-ascii 245 "{~o}") ; o with tilde -(standard-display-g1 246 ?|) ; o with diaeresis or umlaut mark -(standard-display-ascii 247 "{/}") ; division sign -(standard-display-ascii 248 "{/o}") ; o with slash -(standard-display-ascii 249 "{`u}") ; u with grave accent -(standard-display-ascii 250 "{'u}") ; u with acute accent -(standard-display-ascii 251 "{^u}") ; u with circumflex accent -(standard-display-g1 252 ?~) ; u with diaeresis or umlaut mark -(standard-display-ascii 253 "{'y}") ; y with acute accent -(standard-display-ascii 254 "{th}") ; small thorn, Icelandic -(standard-display-ascii 255 "{\"y}") ; small y with diaeresis or umlaut mark - -(provide 'iso-swed) - -;;; iso-swed.el ends here diff --git a/lisp/obsolete/resume.el b/lisp/obsolete/resume.el deleted file mode 100644 index b4dfab2947..0000000000 --- a/lisp/obsolete/resume.el +++ /dev/null @@ -1,125 +0,0 @@ -;;; resume.el --- process command line args from within a suspended Emacs job - -;; Copyright (C) 1992, 2001-2017 Free Software Foundation, Inc. - -;; Author: Joe Wells -;; Adapted-By: ESR -;; Keywords: processes -;; Obsolete-since: 23.1 - -;; 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: - -;; The purpose of this library is to handle command line arguments -;; when you resume an existing Emacs job. - -;; In order to use it, you must put this code in your .emacs file. - -;; (add-hook 'suspend-hook 'resume-suspend-hook) -;; (add-hook 'suspend-resume-hook 'resume-process-args) - -;; You can't get the benefit of this library by using the `emacs' command, -;; since that always starts a new Emacs job. Instead you must use a -;; command called `edit' which knows how to resume an existing Emacs job -;; if you have one, or start a new Emacs job if you don't have one. - -;; To define the `edit' command, run the script etc/emacs.csh (if you use CSH), -;; or etc/emacs.bash if you use BASH. You would normally do this in your -;; login script. - -;; Stephan Gildea suggested bug fix (gildea@bbn.com). -;; Ideas from Michael DeCorte and other people. - -;;; Code: - -(defvar resume-emacs-args-file (expand-file-name "~/.emacs_args") - "This file is where arguments are placed for a suspended Emacs job.") - -(defvar resume-emacs-args-buffer " *Command Line Args*" - "Buffer that is used by `resume-process-args'.") - -(defun resume-process-args () - "Handler for command line args given when Emacs is resumed." - (let ((start-buffer (current-buffer)) - (args-buffer (get-buffer-create resume-emacs-args-buffer)) - length args - (command-line-default-directory default-directory)) - (unwind-protect - (progn - (set-buffer args-buffer) - (erase-buffer) - ;; get the contents of resume-emacs-args-file - (condition-case () - (let ((result (insert-file-contents resume-emacs-args-file))) - (setq length (car (cdr result)))) - ;; the file doesn't exist, ergo no arguments - (file-error - (erase-buffer) - (setq length 0))) - (if (<= length 0) - (setq args nil) - ;; get the arguments from the buffer - (goto-char (point-min)) - (while (not (eobp)) - (skip-chars-forward " \t\n") - (let ((begin (point))) - (skip-chars-forward "^ \t\n") - (setq args (cons (buffer-substring begin (point)) args))) - (skip-chars-forward " \t\n")) - ;; arguments are now in reverse order - (setq args (nreverse args)) - ;; make sure they're not read again - (erase-buffer)) - (resume-write-buffer-to-file (current-buffer) resume-emacs-args-file) - ;; if nothing was in buffer, args will be null - (or (null args) - (setq command-line-default-directory - (file-name-as-directory (car args)) - args (cdr args))) - ;; actually process the arguments - (command-line-1 args)) - ;; If the command line args don't result in a find-file, the - ;; buffer will be left in args-buffer. So we change back to the - ;; original buffer. The reason I don't just use - ;; (let ((default-directory foo)) - ;; (command-line-1 args)) - ;; in the context of the original buffer is because let does not - ;; work properly with buffer-local variables. - (if (eq (current-buffer) args-buffer) - (set-buffer start-buffer))))) - -;;;###autoload -(defun resume-suspend-hook () - "Clear out the file used for transmitting args when Emacs resumes." - (with-current-buffer (get-buffer-create resume-emacs-args-buffer) - (erase-buffer) - (resume-write-buffer-to-file (current-buffer) resume-emacs-args-file))) - -(defun resume-write-buffer-to-file (buffer file) - "Writes the contents of BUFFER into FILE, if permissions allow." - (if (not (file-writable-p file)) - (error "No permission to write file %s" file)) - (with-current-buffer buffer - (clear-visited-file-modtime) - (save-restriction - (widen) - (write-region (point-min) (point-max) file nil 'quiet)) - (set-buffer-modified-p nil))) - -(provide 'resume) - -;;; resume.el ends here diff --git a/lisp/obsolete/scribe.el b/lisp/obsolete/scribe.el deleted file mode 100644 index f9ec9c953c..0000000000 --- a/lisp/obsolete/scribe.el +++ /dev/null @@ -1,329 +0,0 @@ -;;; scribe.el --- scribe mode, and its idiosyncratic commands - -;; Copyright (C) 1985, 2001-2017 Free Software Foundation, Inc. - -;; Author: William Sommerfeld -;; (according to ack.texi) -;; Maintainer: emacs-devel@gnu.org -;; Keywords: wp -;; Obsolete-since: 22.1 - -;; 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: - -;; A major mode for editing source in written for the Scribe text formatter. -;; Knows about Scribe syntax and standard layout rules. The command to -;; run Scribe on a buffer is bogus; someone interested should fix it. - -;;; Code: - -(defvar compile-command) - -(defgroup scribe nil - "Scribe mode." - :prefix "scribe-" - :group 'wp) - -(defvar scribe-mode-syntax-table nil - "Syntax table used while in scribe mode.") - -(defvar scribe-mode-abbrev-table nil - "Abbrev table used while in scribe mode.") - -(defcustom scribe-fancy-paragraphs nil - "Non-nil makes Scribe mode use a different style of paragraph separation." - :type 'boolean - :group 'scribe) - -(defcustom scribe-electric-quote nil - "Non-nil makes insert of double quote use \\=`\\=` or \\='\\=' depending on context." - :type 'boolean - :group 'scribe) - -(defcustom scribe-electric-parenthesis nil - "Non-nil makes parenthesis char ( (]}> ) automatically insert its close -if typed after an @Command form." - :type 'boolean - :group 'scribe) - -(defconst scribe-open-parentheses "[({<" - "Open parenthesis characters for Scribe.") - -(defconst scribe-close-parentheses "])}>" - "Close parenthesis characters for Scribe. -These should match up with `scribe-open-parenthesis'.") - -(if (null scribe-mode-syntax-table) - (let ((st (syntax-table))) - (unwind-protect - (progn - (setq scribe-mode-syntax-table (copy-syntax-table - text-mode-syntax-table)) - (set-syntax-table scribe-mode-syntax-table) - (modify-syntax-entry ?\" " ") - (modify-syntax-entry ?\\ " ") - (modify-syntax-entry ?@ "w ") - (modify-syntax-entry ?< "(> ") - (modify-syntax-entry ?> ")< ") - (modify-syntax-entry ?[ "(] ") - (modify-syntax-entry ?] ")[ ") - (modify-syntax-entry ?{ "(} ") - (modify-syntax-entry ?} "){ ") - (modify-syntax-entry ?' "w ")) - (set-syntax-table st)))) - -(defvar scribe-mode-map nil) - -(if scribe-mode-map - nil - (setq scribe-mode-map (make-sparse-keymap)) - (define-key scribe-mode-map "\t" 'scribe-tab) - (define-key scribe-mode-map "\e\t" 'tab-to-tab-stop) - (define-key scribe-mode-map "\es" 'center-line) - (define-key scribe-mode-map "\e}" 'up-list) - (define-key scribe-mode-map "\eS" 'center-paragraph) - (define-key scribe-mode-map "\"" 'scribe-insert-quote) - (define-key scribe-mode-map "(" 'scribe-parenthesis) - (define-key scribe-mode-map "[" 'scribe-parenthesis) - (define-key scribe-mode-map "{" 'scribe-parenthesis) - (define-key scribe-mode-map "<" 'scribe-parenthesis) - (define-key scribe-mode-map "\C-c\C-c" 'scribe-chapter) - (define-key scribe-mode-map "\C-c\C-t" 'scribe-section) - (define-key scribe-mode-map "\C-c\C-s" 'scribe-subsection) - (define-key scribe-mode-map "\C-c\C-v" 'scribe-insert-environment) - (define-key scribe-mode-map "\C-c\C-e" 'scribe-bracket-region-be) - (define-key scribe-mode-map "\C-c[" 'scribe-begin) - (define-key scribe-mode-map "\C-c]" 'scribe-end) - (define-key scribe-mode-map "\C-c\C-i" 'scribe-italicize-word) - (define-key scribe-mode-map "\C-c\C-b" 'scribe-bold-word) - (define-key scribe-mode-map "\C-c\C-u" 'scribe-underline-word)) - -;;;###autoload -(define-derived-mode scribe-mode text-mode "Scribe" - "Major mode for editing files of Scribe (a text formatter) source. -Scribe-mode is similar to text-mode, with a few extra commands added. -\\{scribe-mode-map} - -Interesting variables: - -`scribe-fancy-paragraphs' - Non-nil makes Scribe mode use a different style of paragraph separation. - -`scribe-electric-quote' - Non-nil makes insert of double quote use \\=`\\=` or \\='\\=' depending on context. - -`scribe-electric-parenthesis' - Non-nil makes an open-parenthesis char (one of `([<{') - automatically insert its close if typed after an @Command form." - (set (make-local-variable 'comment-start) "@Comment[") - (set (make-local-variable 'comment-start-skip) (concat "@Comment[" scribe-open-parentheses "]")) - (set (make-local-variable 'comment-column) 0) - (set (make-local-variable 'comment-end) "]") - (set (make-local-variable 'paragraph-start) - (concat "\\([\n\f]\\)\\|\\(@\\w+[" - scribe-open-parentheses - "].*[" - scribe-close-parentheses - "]$\\)")) - (set (make-local-variable 'paragraph-separate) - (if scribe-fancy-paragraphs paragraph-start "$")) - (set (make-local-variable 'sentence-end) - "\\([.?!]\\|@:\\)[]\"')}]*\\($\\| $\\|\t\\| \\)[ \t\n]*") - (set (make-local-variable 'compile-command) - (concat "scribe " - (if buffer-file-name - (shell-quote-argument (buffer-file-name)))))) - -(defun scribe-tab () - (interactive) - (insert "@\\")) - -;; This algorithm could probably be improved somewhat. -;; Right now, it loses seriously... - -(defun scribe () - "Run Scribe on the current buffer." - (interactive) - (call-interactively 'compile)) - -(defun scribe-envelop-word (string count) - "Surround current word with Scribe construct @STRING[...]. -COUNT specifies how many words to surround. A negative count means -to skip backward." - (let ((spos (point)) (epos (point)) (ccoun 0) noparens) - (if (not (zerop count)) - (progn (if (= (char-syntax (preceding-char)) ?w) - (forward-sexp (min -1 count))) - (setq spos (point)) - (if (looking-at (concat "@\\w[" scribe-open-parentheses "]")) - (forward-char 2) - (goto-char epos) - (skip-chars-backward "\\W") - (forward-char -1)) - (forward-sexp (max count 1)) - (setq epos (point)))) - (goto-char spos) - (while (and (< ccoun (length scribe-open-parentheses)) - (save-excursion - (or (search-forward (char-to-string - (aref scribe-open-parentheses ccoun)) - epos t) - (search-forward (char-to-string - (aref scribe-close-parentheses ccoun)) - epos t))) - (setq ccoun (1+ ccoun)))) - (if (>= ccoun (length scribe-open-parentheses)) - (progn (goto-char epos) - (insert "@end(" string ")") - (goto-char spos) - (insert "@begin(" string ")")) - (goto-char epos) - (insert (aref scribe-close-parentheses ccoun)) - (goto-char spos) - (insert "@" string (aref scribe-open-parentheses ccoun)) - (goto-char epos) - (forward-char 3) - (skip-chars-forward scribe-close-parentheses)))) - -(defun scribe-underline-word (count) - "Underline COUNT words around point by means of Scribe constructs." - (interactive "p") - (scribe-envelop-word "u" count)) - -(defun scribe-bold-word (count) - "Boldface COUNT words around point by means of Scribe constructs." - (interactive "p") - (scribe-envelop-word "b" count)) - -(defun scribe-italicize-word (count) - "Italicize COUNT words around point by means of Scribe constructs." - (interactive "p") - (scribe-envelop-word "i" count)) - -(defun scribe-begin () - (interactive) - (insert "\n") - (forward-char -1) - (scribe-envelop-word "Begin" 0) - (re-search-forward (concat "[" scribe-open-parentheses "]"))) - -(defun scribe-end () - (interactive) - (insert "\n") - (forward-char -1) - (scribe-envelop-word "End" 0) - (re-search-forward (concat "[" scribe-open-parentheses "]"))) - -(defun scribe-chapter () - (interactive) - (insert "\n") - (forward-char -1) - (scribe-envelop-word "Chapter" 0) - (re-search-forward (concat "[" scribe-open-parentheses "]"))) - -(defun scribe-section () - (interactive) - (insert "\n") - (forward-char -1) - (scribe-envelop-word "Section" 0) - (re-search-forward (concat "[" scribe-open-parentheses "]"))) - -(defun scribe-subsection () - (interactive) - (insert "\n") - (forward-char -1) - (scribe-envelop-word "SubSection" 0) - (re-search-forward (concat "[" scribe-open-parentheses "]"))) - -(defun scribe-bracket-region-be (env min max) - (interactive "sEnvironment: \nr") - (save-excursion - (goto-char max) - (insert "@end(" env ")\n") - (goto-char min) - (insert "@begin(" env ")\n"))) - -(defun scribe-insert-environment (env) - (interactive "sEnvironment: ") - (scribe-bracket-region-be env (point) (point)) - (forward-line 1) - (insert ?\n) - (forward-char -1)) - -(defun scribe-insert-quote (count) - "Insert \\=`\\=`, \\='\\=' or \" according to preceding character. -If `scribe-electric-quote' is non-nil, insert \\=`\\=`, \\='\\=' or \" according -to preceding character. With numeric arg N, always insert N \" characters. -Else just insert \"." - (interactive "P") - (if (or count (not scribe-electric-quote)) - (self-insert-command (prefix-numeric-value count)) - (let (lastfore lastback lastquote) - (insert - (cond - ((= (preceding-char) ?\\) ?\") - ((bobp) "``") - (t - (setq lastfore (save-excursion (and (search-backward - "``" (- (point) 1000) t) - (point))) - lastback (save-excursion (and (search-backward - "''" (- (point) 1000) t) - (point))) - lastquote (save-excursion (and (search-backward - "\"" (- (point) 100) t) - (point)))) - (if (not lastquote) - (cond ((not lastfore) "``") - ((not lastback) "''") - ((> lastfore lastback) "''") - (t "``")) - (cond ((and (not lastback) (not lastfore)) "\"") - ((and lastback (not lastfore) (> lastquote lastback)) "\"") - ((and lastback (not lastfore) (> lastback lastquote)) "``") - ((and lastfore (not lastback) (> lastquote lastfore)) "\"") - ((and lastfore (not lastback) (> lastfore lastquote)) "''") - ((and (> lastquote lastfore) (> lastquote lastback)) "\"") - ((> lastfore lastback) "''") - (t "``"))))))))) - -(defun scribe-parenthesis (count) - "If scribe-electric-parenthesis is non-nil, insertion of an open-parenthesis -character inserts the following close parenthesis character if the -preceding text is of the form @Command." - (interactive "P") - (self-insert-command (prefix-numeric-value count)) - (let (at-command paren-char point-save) - (if (or count (not scribe-electric-parenthesis)) - nil - (save-excursion - (forward-char -1) - (setq point-save (point)) - (skip-chars-backward (concat "^ \n\t\f" scribe-open-parentheses)) - (setq at-command (and (equal (following-char) ?@) - (/= (point) (1- point-save))))) - (if (and at-command - (setq paren-char - (string-match (regexp-quote - (char-to-string (preceding-char))) - scribe-open-parentheses))) - (save-excursion - (insert (aref scribe-close-parentheses paren-char))))))) - -(provide 'scribe) - -;;; scribe.el ends here diff --git a/lisp/obsolete/spell.el b/lisp/obsolete/spell.el deleted file mode 100644 index 5f8ad13b51..0000000000 --- a/lisp/obsolete/spell.el +++ /dev/null @@ -1,171 +0,0 @@ -;;; spell.el --- spelling correction interface for Emacs - -;; Copyright (C) 1985, 2001-2017 Free Software Foundation, Inc. - -;; Maintainer: emacs-devel@gnu.org -;; Keywords: wp, unix -;; Obsolete-since: 23.1 -;; (not in obsolete/ directory then, but all functions marked obsolete) - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Commentary: - -;; This mode provides an Emacs interface to the UNIX spell(1) program. -;; Entry points are `spell-buffer', `spell-word', `spell-region' and -;; `spell-string'. - -;; See also ispell.el for an interface to the ispell program. - -;;; Code: - -(defgroup spell nil - "Interface to the UNIX spell(1) program." - :prefix "spell-" - :group 'applications) - -(defcustom spell-command "spell" - "Command to run the spell program." - :type 'string - :group 'spell) - -(defcustom spell-filter nil - "Filter function to process text before passing it to spell program. -This function might remove text-processor commands. -nil means don't alter the text before checking it." - :type '(choice (const nil) function) - :group 'spell) - -;;;###autoload -(put 'spell-filter 'risky-local-variable t) - -;;;###autoload -(defun spell-buffer () - "Check spelling of every word in the buffer. -For each incorrect word, you are asked for the correct spelling -and then put into a query-replace to fix some or all occurrences. -If you do not want to change a word, just give the same word -as its \"correct\" spelling; then the query replace is skipped." - (interactive) - ;; Don't warn about spell-region being obsolete. - (with-no-warnings - (spell-region (point-min) (point-max) "buffer"))) -;;;###autoload -(make-obsolete 'spell-buffer 'ispell-buffer "23.1") - -;;;###autoload -(defun spell-word () - "Check spelling of word at or before point. -If it is not correct, ask user for the correct spelling -and `query-replace' the entire buffer to substitute it." - (interactive) - (let (beg end spell-filter) - (save-excursion - (if (not (looking-at "\\<")) - (forward-word -1)) - (setq beg (point)) - (forward-word 1) - (setq end (point))) - ;; Don't warn about spell-region being obsolete. - (with-no-warnings - (spell-region beg end (buffer-substring beg end))))) -;;;###autoload -(make-obsolete 'spell-word 'ispell-word "23.1") - -;;;###autoload -(defun spell-region (start end &optional description) - "Like `spell-buffer' but applies only to region. -Used in a program, applies from START to END. -DESCRIPTION is an optional string naming the unit being checked: -for example, \"word\"." - (interactive "r") - (let ((filter spell-filter) - (buf (get-buffer-create " *temp*"))) - (with-current-buffer buf - (widen) - (erase-buffer)) - (message "Checking spelling of %s..." (or description "region")) - (if (and (null filter) (= ?\n (char-after (1- end)))) - (if (string= "spell" spell-command) - (call-process-region start end "spell" nil buf) - (call-process-region start end shell-file-name - nil buf nil "-c" spell-command)) - (let ((oldbuf (current-buffer))) - (with-current-buffer buf - (insert-buffer-substring oldbuf start end) - (or (bolp) (insert ?\n)) - (if filter (funcall filter)) - (if (string= "spell" spell-command) - (call-process-region (point-min) (point-max) "spell" t buf) - (call-process-region (point-min) (point-max) shell-file-name - t buf nil "-c" spell-command))))) - (message "Checking spelling of %s...%s" - (or description "region") - (if (with-current-buffer buf - (> (buffer-size) 0)) - "not correct" - "correct")) - (let (word newword - (case-fold-search t) - (case-replace t)) - (while (with-current-buffer buf - (> (buffer-size) 0)) - (with-current-buffer buf - (goto-char (point-min)) - (setq word (downcase - (buffer-substring (point) - (progn (end-of-line) (point))))) - (forward-char 1) - (delete-region (point-min) (point)) - (setq newword - (read-string (concat "`" word - "' not recognized; edit a replacement: ") - word)) - (flush-lines (concat "^" (regexp-quote word) "$"))) - (if (not (equal word newword)) - (progn - (goto-char (point-min)) - (query-replace-regexp (concat "\\b" (regexp-quote word) "\\b") - newword))))))) -;;;###autoload -(make-obsolete 'spell-region 'ispell-region "23.1") - -;;;###autoload -(defun spell-string (string) - "Check spelling of string supplied as argument." - (interactive "sSpell string: ") - (with-temp-buffer - (widen) - (erase-buffer) - (insert string "\n") - (if (string= "spell" spell-command) - (call-process-region (point-min) (point-max) "spell" - t t) - (call-process-region (point-min) (point-max) shell-file-name - t t nil "-c" spell-command)) - (if (= 0 (buffer-size)) - (message "%s is correct" string) - (goto-char (point-min)) - (while (search-forward "\n" nil t) - (replace-match " ")) - (message "%sincorrect" (buffer-substring 1 (point-max)))))) -;;;###autoload -(make-obsolete 'spell-string "The `spell' package is obsolete - use `ispell'." - "23.1") - -(provide 'spell) - -;;; spell.el ends here diff --git a/lisp/obsolete/swedish.el b/lisp/obsolete/swedish.el deleted file mode 100644 index 2254441071..0000000000 --- a/lisp/obsolete/swedish.el +++ /dev/null @@ -1,160 +0,0 @@ -;;; swedish.el --- miscellaneous functions for dealing with Swedish - -;; Copyright (C) 1988, 2001-2017 Free Software Foundation, Inc. - -;; Author: Howard Gayle -;; Maintainer: emacs-devel@gnu.org -;; Keywords: i18n -;; Obsolete-since: 22.1 - -;; 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: - -;; Fixme: Is this actually used? if so, it should be in language, -;; possibly as a feature property of Swedish, probably defining a -;; `swascii' coding system. - -;;; Code: - -;; Written by Howard Gayle. See case-table.el for details. - -;; See iso-swed.el for a description of the character set. - -(defvar mail-send-hook) -(defvar news-group-hook-alist) -(defvar news-inews-hook) - -(defvar swedish-re - "[ \t\n]\\(och\\|att\\|en\\|{r\\|\\[R\\|p}\\|P\\]\\|som\\|det\\|av\\|den\\|f|r\\|F\\\\R\\)[ \t\n.,?!:;'\")}]" - "Regular expression for common Swedish words.") - -(defvar swascii-to-8859-trans - (let ((string (make-string 256 ? )) - (i 0)) - (while (< i 256) - (aset string i i) - (setq i (1+ i))) - (aset string ?\[ 196) - (aset string ?\] 197) - (aset string ?\\ 214) - (aset string ?^ 220) - (aset string ?\{ 228) - (aset string ?\} 229) - (aset string ?\` 233) - (aset string ?\| 246) - (aset string ?~ 252) - string) - "Trans table from SWASCII to 8859.") - -; $ is not converted because it almost always means US -; dollars, not general currency sign. @ is not converted -; because it is more likely to be an at sign in a mail address -; than an E with acute accent. - -(defun swascii-to-8859-buffer () - "Convert characters in buffer from Swedish/Finnish-ascii to ISO 8859/1. -Works even on read-only buffers. `$' and `@' are not converted." - (interactive) - (let ((buffer-read-only nil)) - (translate-region (point-min) (point-max) swascii-to-8859-trans))) - -(defun swascii-to-8859-buffer-maybe () - "Call swascii-to-8859-buffer if the buffer looks like Swedish-ascii. -Leaves point just after the word that looks Swedish." - (interactive) - (let ((case-fold-search t)) - (if (re-search-forward swedish-re nil t) - (swascii-to-8859-buffer)))) - -(setq rmail-show-message-hook 'swascii-to-8859-buffer-maybe) - -(setq news-group-hook-alist - (append '(("^swnet." . swascii-to-8859-buffer-maybe)) - (bound-and-true-p news-group-hook-alist))) - -(defvar 8859-to-swascii-trans - (let ((string (make-string 256 ? )) - (i 0)) - (while (< i 256) - (aset string i i) - (setq i (1+ i))) - (aset string 164 ?$) - (aset string 196 ?\[) - (aset string 197 ?\]) - (aset string 201 ?@) - (aset string 214 ?\\) - (aset string 220 ?^) - (aset string 228 ?\{) - (aset string 229 ?\}) - (aset string 233 ?\`) - (aset string 246 ?\|) - (aset string 252 ?~) - string) - "8859 to SWASCII trans table.") - -(defun 8859-to-swascii-buffer () - "Convert characters in buffer from ISO 8859/1 to Swedish/Finnish-ascii." - (interactive "*") - (translate-region (point-min) (point-max) 8859-to-swascii-trans)) - -(setq mail-send-hook '8859-to-swascii-buffer) -(setq news-inews-hook '8859-to-swascii-buffer) - -;; It's not clear what purpose is served by a separate -;; Swedish mode that differs from Text mode only in having -;; a separate abbrev table. Nothing says that the abbrevs you -;; define in Text mode have to be English! - -;(defvar swedish-mode-abbrev-table nil -; "Abbrev table used while in swedish mode.") -;(define-abbrev-table 'swedish-mode-abbrev-table ()) - -;(defun swedish-mode () -; "Major mode for editing Swedish text intended for humans to -;read. Special commands:\\{text-mode-map} -;Turning on swedish-mode calls the value of the variable -;text-mode-hook, if that value is non-nil." -; (interactive) -; (kill-all-local-variables) -; (use-local-map text-mode-map) -; (setq mode-name "Swedish") -; (setq major-mode 'swedish-mode) -; (setq local-abbrev-table swedish-mode-abbrev-table) -; (set-syntax-table text-mode-syntax-table) -; (run-mode-hooks 'text-mode-hook)) - -;(defun indented-swedish-mode () -; "Major mode for editing indented Swedish text intended for -;humans to read.\\{indented-text-mode-map} -;Turning on indented-swedish-mode calls the value of the -;variable text-mode-hook, if that value is non-nil." -; (interactive) -; (kill-all-local-variables) -; (use-local-map text-mode-map) -; (define-abbrev-table 'swedish-mode-abbrev-table ()) -; (setq local-abbrev-table swedish-mode-abbrev-table) -; (set-syntax-table text-mode-syntax-table) -; (make-local-variable 'indent-line-function) -; (setq indent-line-function 'indent-relative-maybe) -; (use-local-map indented-text-mode-map) -; (setq mode-name "Indented Swedish") -; (setq major-mode 'indented-swedish-mode) -; (run-mode-hooks 'text-mode-hook)) - -(provide 'swedish) - -;;; swedish.el ends here diff --git a/lisp/obsolete/sym-comp.el b/lisp/obsolete/sym-comp.el deleted file mode 100644 index 4418450fe4..0000000000 --- a/lisp/obsolete/sym-comp.el +++ /dev/null @@ -1,237 +0,0 @@ -;;; sym-comp.el --- mode-dependent symbol completion - -;; Copyright (C) 2004, 2008-2017 Free Software Foundation, Inc. - -;; Author: Dave Love -;; Keywords: extensions -;; URL: http://www.loveshack.ukfsn.org/emacs -;; Obsolete-since: 23.2 - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Commentary: - -;; This defines `symbol-complete', which is a generalization of the -;; old `lisp-complete-symbol'. It provides the following hooks to -;; allow major modes to set up completion appropriate for the mode: -;; `symbol-completion-symbol-function', -;; `symbol-completion-completions-function', -;; `symbol-completion-predicate-function', -;; `symbol-completion-transform-function'. Typically it is only -;; necessary for a mode to set -;; `symbol-completion-completions-function' locally and to bind -;; `symbol-complete' appropriately. - -;; It's unfortunate that there doesn't seem to be a good way of -;; combining this with `complete-symbol'. - -;; There is also `symbol-completion-try-complete', for use with -;; Hippie-exp. - -;;; Code: - -;;;; Mode-dependent symbol completion. - -(defun symbol-completion-symbol () - "Default `symbol-completion-symbol-function'. -Uses `current-word' with the buffer narrowed to the part before -point." - (save-restriction - ;; Narrow in case point is in the middle of a symbol -- we want - ;; just the preceding part. - (narrow-to-region (point-min) (point)) - (current-word))) - -(defvar symbol-completion-symbol-function 'symbol-completion-symbol - "Function to return a partial symbol before point for completion. -The value it returns should be a string (or nil). -Major modes may set this locally if the default isn't appropriate. - -Beware: the length of the string STR returned need to be equal to the length -of text before point that's subject to completion. Typically, this amounts -to saying that STR is equal to -\(buffer-substring (- (point) (length STR)) (point)).") - -(defvar symbol-completion-completions-function nil - "Function to return possible symbol completions. -It takes an argument which is the string to be completed and -returns a value suitable for the second argument of -`try-completion'. This value need not use the argument, i.e. it -may be all possible completions, such as `obarray' in the case of -Emacs Lisp. - -Major modes may set this locally to allow them to support -`symbol-complete'. See also `symbol-completion-symbol-function', -`symbol-completion-predicate-function' and -`symbol-completion-transform-function'.") - -(defvar symbol-completion-predicate-function nil - "If non-nil, function to return a predicate for selecting symbol completions. -The function gets two args, the positions of the beginning and -end of the symbol to be completed. - -Major modes may set this locally if the default isn't -appropriate. This is a function returning a predicate so that -the predicate can be context-dependent, e.g. to select only -function names if point is at a function call position. The -function's args may be useful for determining the context.") - -(defvar symbol-completion-transform-function nil - "If non-nil, function to transform symbols in the symbol-completion buffer. -E.g., for Lisp, it may annotate the symbol as being a function, -not a variable. - -The function takes the symbol name as argument. If it needs to -annotate this, it should return a value suitable as an element of -the list passed to `display-completion-list'. - -The predicate being used for selecting completions (from -`symbol-completion-predicate-function') is available -dynamically-bound as `symbol-completion-predicate' in case the -transform needs it.") - -(defvar symbol-completion-predicate) - -;;;###autoload -(defun symbol-complete (&optional predicate) - "Perform completion of the symbol preceding point. -This is done in a way appropriate to the current major mode, -perhaps by interrogating an inferior interpreter. Compare -`complete-symbol'. -If no characters can be completed, display a list of possible completions. -Repeating the command at that point scrolls the list. - -When called from a program, optional arg PREDICATE is a predicate -determining which symbols are considered. - -This function requires `symbol-completion-completions-function' -to be set buffer-locally. Variables `symbol-completion-symbol-function', -`symbol-completion-predicate-function' and -`symbol-completion-transform-function' are also consulted." - (interactive) - ;; Fixme: Punt to `complete-symbol' in this case? - (unless (functionp symbol-completion-completions-function) - (error "symbol-completion-completions-function not defined")) - (let* ((pattern (or (funcall symbol-completion-symbol-function) - (error "No preceding symbol to complete"))) - ;; FIXME: We assume below that `pattern' holds the text just - ;; before point. This is a problem in the way - ;; symbol-completion-symbol-function was defined. - (predicate (or predicate - (if symbol-completion-predicate-function - (funcall symbol-completion-predicate-function - (- (point) (length pattern)) - (point))))) - (completions (funcall symbol-completion-completions-function - pattern)) - ;; In case the transform needs to access it. - (symbol-completion-predicate predicate) - (completion-extra-properties - (if (functionp symbol-completion-transform-function) - '(:annotation-function - (lambda (str) - (car-safe (cdr-safe - (funcall symbol-completion-transform-function - str)))))))) - (completion-in-region (- (point) (length pattern)) (point) - completions predicate))) - -(defvar he-search-string) -(defvar he-tried-table) -(defvar he-expand-list) -(declare-function he-init-string "hippie-exp" (beg end)) -(declare-function he-string-member "hippie-exp" (str lst &optional trans-case)) -(declare-function he-substitute-string "hippie-exp" (str &optional trans-case)) -(declare-function he-reset-string "hippie-exp" ()) - -;;;###autoload -(defun symbol-completion-try-complete (old) - "Completion function for use with `hippie-expand'. -Uses `symbol-completion-symbol-function' and -`symbol-completion-completions-function'. It is intended to be -used something like this in a major mode which provides symbol -completion: - - (if (featurep \\='hippie-exp) - (set (make-local-variable \\='hippie-expand-try-functions-list) - (cons \\='symbol-completion-try-complete - hippie-expand-try-functions-list)))" - (when (and symbol-completion-symbol-function - symbol-completion-completions-function) - (unless old - (let ((symbol (funcall symbol-completion-symbol-function))) - (he-init-string (- (point) (length symbol)) (point)) - (if (not (he-string-member he-search-string he-tried-table)) - (push he-search-string he-tried-table)) - (setq he-expand-list - (and symbol - (funcall symbol-completion-completions-function symbol))))) - (while (and he-expand-list - (he-string-member (car he-expand-list) he-tried-table)) - (pop he-expand-list)) - (if he-expand-list - (progn - (he-substitute-string (pop he-expand-list)) - t) - (if old (he-reset-string)) - nil))) - -;;; Emacs Lisp symbol completion. - -(defun lisp-completion-symbol () - "`symbol-completion-symbol-function' for Lisp." - (let ((end (point)) - (beg (with-syntax-table emacs-lisp-mode-syntax-table - (save-excursion - (backward-sexp 1) - (while (= (char-syntax (following-char)) ?\') - (forward-char 1)) - (point))))) - (buffer-substring-no-properties beg end))) - -(defun lisp-completion-predicate (beg end) - "`symbol-completion-predicate-function' for Lisp." - (save-excursion - (goto-char beg) - (if (not (eq (char-before) ?\()) - (lambda (sym) ;why not just nil ? -sm - ;To avoid interned symbols with - ;no slots. -- fx - (or (boundp sym) (fboundp sym) - (symbol-plist sym))) - ;; Looks like a funcall position. Let's double check. - (if (condition-case nil - (progn (up-list -2) (forward-char 1) - (eq (char-after) ?\()) - (error nil)) - ;; If the first element of the parent list is an open - ;; parenthesis we are probably not in a funcall position. - ;; Maybe a `let' varlist or something. - nil - ;; Else, we assume that a function name is expected. - 'fboundp)))) - -(defun lisp-symbol-completion-transform () - "`symbol-completion-transform-function' for Lisp." - (lambda (elt) - (if (and (not (eq 'fboundp symbol-completion-predicate)) - (fboundp (intern elt))) - (list elt " ") - elt))) - -(provide 'sym-comp) - -;;; sym-comp.el ends here commit 214a67b00b7b47445bcff284168da56b4934ffdb Author: Noam Postavsky Date: Sat Dec 17 18:01:52 2016 -0500 Warn about incomplete untarring of link files The current tar-mode doesn't really support unpacking symlinks, it simply creates an empty file of the same name. * lisp/tar-mode.el (tar--describe-as-link): New function extracted from `tar--check-descriptor'. (tar-untar-buffer): Use it to warn about imperfectly untarred link files. diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el index 345333b8bc..f25b1a45ba 100644 --- a/lisp/tar-mode.el +++ b/lisp/tar-mode.el @@ -544,6 +544,7 @@ MODE should be an integer which is a file mode value." (dir (if (eq (tar-header-link-type descriptor) 5) name (file-name-directory name))) + (link-desc (tar--describe-as-link descriptor)) (start (tar-header-data-start descriptor)) (end (+ start (tar-header-size descriptor)))) (unless (file-directory-p name) @@ -552,6 +553,10 @@ MODE should be an integer which is a file mode value." (make-directory dir t)) (unless (file-directory-p name) (let ((coding-system-for-write 'no-conversion)) + (when link-desc + (lwarn '(tar link) :warning + "Extracted `%s', %s, as a normal file" + name link-desc)) (write-region start end name))) (set-file-modes name (tar-header-mode descriptor)))))))) @@ -816,19 +821,23 @@ tar-file's buffer." nil (error "This line does not describe a tar-file entry")))) -(defun tar--check-descriptor (descriptor) +(defun tar--describe-as-link (descriptor) (let ((link-p (tar-header-link-type descriptor))) (if link-p - (error "This is %s, not a real file" - (cond ((eq link-p 5) "a directory") - ((eq link-p 20) "a tar directory header") - ((eq link-p 28) "a next has longname") - ((eq link-p 29) "a multivolume-continuation") - ((eq link-p 35) "a sparse entry") - ((eq link-p 38) "a volume header") - ((eq link-p 55) "a pax global extended header") - ((eq link-p 72) "a pax extended header") - (t "a link")))))) + (cond ((eq link-p 5) "a directory") + ((eq link-p 20) "a tar directory header") + ((eq link-p 28) "a next has longname") + ((eq link-p 29) "a multivolume-continuation") + ((eq link-p 35) "a sparse entry") + ((eq link-p 38) "a volume header") + ((eq link-p 55) "a pax global extended header") + ((eq link-p 72) "a pax extended header") + (t "a link"))))) + +(defun tar--check-descriptor (descriptor) + (let ((link-desc (tar--describe-as-link descriptor))) + (when link-desc + (error "This is %s, not a real file" link-desc)))) (defun tar-get-descriptor () (let* ((descriptor (tar-current-descriptor)) commit 5da2a5f449cd0c8f16f2244c90b57e27ca373892 Author: Noam Postavsky Date: Mon Dec 19 20:16:50 2016 -0500 Remove sh-mode's skeleton-end-hook * lisp/progmodes/sh-script.el (sh-mode): Remove local setting of `skeleton-end-hook', `skeleton-insert' already does `newline-and-indent' and also respects `skeleton-end-newline' (Bug#16634). diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index da0819e107..a0bbf55a8f 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -1629,8 +1629,6 @@ with your script for an edit-interpret-debug cycle." (setq-local skeleton-pair-default-alist sh-skeleton-pair-default-alist) - (setq-local skeleton-end-hook - (lambda () (or (eolp) (newline) (indent-relative)))) (setq-local paragraph-start (concat page-delimiter "\\|$")) (setq-local paragraph-separate (concat paragraph-start "\\|#!/")) commit eb3416016b473478df027ab176f512d7136f8d45 Author: Paul Eggert Date: Sun Jan 1 10:54:28 2017 -0800 * nt/gnulib.mk (stdint.h): Update to match lib/gnulib.mk here. diff --git a/nt/gnulib.mk b/nt/gnulib.mk index 916128f9be..87b47a3bf5 100644 --- a/nt/gnulib.mk +++ b/nt/gnulib.mk @@ -820,6 +820,7 @@ stdint.h: stdint.in.h $(top_builddir)/config.status -e 's/@''BITSIZEOF_WINT_T''@/$(BITSIZEOF_WINT_T)/g' \ -e 's/@''HAVE_SIGNED_WINT_T''@/$(HAVE_SIGNED_WINT_T)/g' \ -e 's/@''WINT_T_SUFFIX''@/$(WINT_T_SUFFIX)/g' \ + -e 's/@''GNULIB_OVERRIDES_WINT_T''@/$(GNULIB_OVERRIDES_WINT_T)/g' \ < $(srcdir)/stdint.in.h; \ } > $@-t && \ mv $@-t $@ commit bd34a6c73f2651e9413b138cf98240faf559c790 Author: Mark Oteiza Date: Sun Jan 1 11:50:59 2017 -0500 Add term/tmux.el Since tmux version 2.1, new tmux terminfos are shipped due to oddities with xterm and screen terminfos. This is simply a duplication of term/screen.el with screen -> tmux. * lisp/term/tmux.el: New file. diff --git a/lisp/term/tmux.el b/lisp/term/tmux.el new file mode 100644 index 0000000000..60d18d7329 --- /dev/null +++ b/lisp/term/tmux.el @@ -0,0 +1,25 @@ +;;; tmux.el --- terminal initialization for tmux -*- lexical-binding: t -*- +;; Copyright (C) 2017 Free Software Foundation, Inc. + +(require 'term/xterm) + +(defcustom xterm-tmux-extra-capabilities '(modifyOtherKeys) + "Extra capabilities supported under \"tmux\". +Some features of tmux depend on the terminal emulator in which +it runs, which can change when the tmux session is moved to another tty." + :version "26.1" + :type xterm--extra-capabilities-type + :group 'xterm) + +(defun terminal-init-tmux () + "Terminal initialization function for tmux." + ;; Treat a tmux terminal similar to an xterm, but don't use + ;; xterm-extra-capabilities's `check' setting since that doesn't seem + ;; to work so well (it depends too much on the surrounding terminal + ;; emulator, which can change during the session, bug#20356). + (let ((xterm-extra-capabilities xterm-tmux-extra-capabilities)) + (tty-run-terminal-initialization (selected-frame) "xterm"))) + +(provide 'term/tmux) + +;; tmux.el ends here commit 93be35e038bbb19e8d64d3c1f9d1be76a9083d09 Author: Philipp Stephani Date: Mon Oct 24 21:54:51 2016 +0200 Fix encoding of JSON surrogate pairs JSON requires that such pairs be treated as UTF-16 surrogate pairs, not individual code points; cf. Bug #24784. * lisp/json.el (json-read-escaped-char): Fix decoding of surrogate pairs. (json--decode-utf-16-surrogates): New defun. * test/lisp/json-tests.el (test-json-read-string): Add test for surrogate pairs. diff --git a/lisp/json.el b/lisp/json.el index 38f828e8fb..b2ac356641 100644 --- a/lisp/json.el +++ b/lisp/json.el @@ -363,6 +363,10 @@ representation will be parsed correctly." ;; String parsing +(defun json--decode-utf-16-surrogates (high low) + "Return the code point represented by the UTF-16 surrogates HIGH and LOW." + (+ (lsh (- high #xD800) 10) (- low #xDC00) #x10000)) + (defun json-read-escaped-char () "Read the JSON string escaped character at point." ;; Skip over the '\' @@ -372,6 +376,17 @@ representation will be parsed correctly." (cond (special (cdr special)) ((not (eq char ?u)) char) + ;; Special-case UTF-16 surrogate pairs, + ;; cf. https://tools.ietf.org/html/rfc7159#section-7. Note that + ;; this clause overlaps with the next one and therefore has to + ;; come first. + ((looking-at + (rx (group (any "Dd") (any "89ABab") (= 2 (any "0-9A-Fa-f"))) + "\\u" (group (any "Dd") (any "C-Fc-f") (= 2 (any "0-9A-Fa-f"))))) + (json-advance 10) + (json--decode-utf-16-surrogates + (string-to-number (match-string 1) 16) + (string-to-number (match-string 2) 16))) ((looking-at "[0-9A-Fa-f][0-9A-Fa-f][0-9A-Fa-f][0-9A-Fa-f]") (let ((hex (match-string 0))) (json-advance 4) diff --git a/test/lisp/json-tests.el b/test/lisp/json-tests.el index 66fc25ad1c..38672de066 100644 --- a/test/lisp/json-tests.el +++ b/test/lisp/json-tests.el @@ -167,6 +167,9 @@ Point is moved to beginning of the buffer." (should (equal (json-read-string) "abcαβγ"))) (json-tests--with-temp-buffer "\"\\nasd\\u0444\\u044b\\u0432fgh\\t\"" (should (equal (json-read-string) "\nasdфывfgh\t"))) + ;; Bug#24784 + (json-tests--with-temp-buffer "\"\\uD834\\uDD1E\"" + (should (equal (json-read-string) "\U0001D11E"))) (json-tests--with-temp-buffer "foo" (should-error (json-read-string) :type 'json-string-format))) commit baa370f255d2f9d3f662fac0de98eaadd3242aa6 Author: Michael Albinus Date: Sun Jan 1 13:03:55 2017 +0100 Remove tramp-gw.el, which was synced from emacs-25 by accident diff --git a/lisp/net/tramp-gw.el b/lisp/net/tramp-gw.el deleted file mode 100644 index 7777212947..0000000000 --- a/lisp/net/tramp-gw.el +++ /dev/null @@ -1,336 +0,0 @@ -;;; tramp-gw.el --- Tramp utility functions for HTTP tunnels and SOCKS gateways - -;; Copyright (C) 2007-2017 Free Software Foundation, Inc. - -;; Author: Michael Albinus -;; Keywords: comm, processes -;; Package: tramp - -;; 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: - -;; Access functions for HTTP tunnels and SOCKS gateways from Tramp. -;; SOCKS functionality is implemented by socks.el from the w3 package. -;; HTTP tunnels are partly implemented in socks.el and url-http.el; -;; both implementations are not complete. Therefore, it is -;; implemented in this package. - -;;; Code: - -(require 'tramp) - -;; Pacify byte-compiler. -(eval-when-compile - (require 'cl) - (require 'custom)) -(defvar socks-noproxy) - -;; We don't add the following methods to `tramp-methods', in order to -;; exclude them from file name completion. - -;; Define HTTP tunnel method ... -;;;###tramp-autoload -(defconst tramp-gw-tunnel-method "tunnel" - "Method to connect HTTP gateways.") - -;; ... and port. -(defconst tramp-gw-default-tunnel-port 8080 - "Default port for HTTP gateways.") - -;; Define SOCKS method ... -;;;###tramp-autoload -(defconst tramp-gw-socks-method "socks" - "Method to connect SOCKS servers.") - -;; ... and port. -(defconst tramp-gw-default-socks-port 1080 - "Default port for SOCKS servers.") - -;; Autoload the socks library. It is used only when we access a SOCKS server. -(autoload 'socks-open-network-stream "socks") -(defvar socks-username (user-login-name)) -(defvar socks-server - (list "Default server" "socks" tramp-gw-default-socks-port 5)) - -;; Add a default for `tramp-default-user-alist'. Default is the local user. -;;;###tramp-autoload -(add-to-list - 'tramp-default-user-alist - (list (concat "\\`" - (regexp-opt (list tramp-gw-tunnel-method tramp-gw-socks-method)) - "\\'") - nil (user-login-name))) - -;; Internal file name functions and variables. - -(defvar tramp-gw-vector nil - "Keeps the remote host identification. Needed for Tramp messages.") - -(defvar tramp-gw-gw-vector nil - "Current gateway identification vector.") - -(defvar tramp-gw-gw-proc nil - "Current gateway process.") - -;; This variable keeps the listening process, in order to reuse it for -;; new processes. -(defvar tramp-gw-aux-proc nil - "Process listening on local port, as mediation between SSH and the gateway.") - -(defun tramp-gw-gw-proc-sentinel (proc _event) - "Delete auxiliary process when we are deleted." - (unless (memq (process-status proc) '(run open)) - (tramp-message - tramp-gw-vector 4 "Deleting auxiliary process `%s'" tramp-gw-gw-proc) - (let* ((tramp-verbose 0) - (p (tramp-get-connection-property proc "process" nil))) - (when (processp p) (delete-process p))))) - -(defun tramp-gw-aux-proc-sentinel (proc _event) - "Activate the different filters for involved gateway and auxiliary processes." - (when (memq (process-status proc) '(run open)) - ;; A new process has been spawned from `tramp-gw-aux-proc'. - (tramp-message - tramp-gw-vector 4 - "Opening auxiliary process `%s', speaking with process `%s'" - proc tramp-gw-gw-proc) - (tramp-compat-set-process-query-on-exit-flag proc nil) - ;; We don't want debug messages, because the corresponding debug - ;; buffer might be undecided. - (let ((tramp-verbose 0)) - (tramp-set-connection-property tramp-gw-gw-proc "process" proc) - (tramp-set-connection-property proc "process" tramp-gw-gw-proc)) - ;; Set the process-filter functions for both processes. - (set-process-filter proc 'tramp-gw-process-filter) - (set-process-filter tramp-gw-gw-proc 'tramp-gw-process-filter) - ;; There might be already some output from the gateway process. - (with-current-buffer (process-buffer tramp-gw-gw-proc) - (unless (= (point-min) (point-max)) - (let ((s (buffer-string))) - (delete-region (point) (point-max)) - (tramp-gw-process-filter tramp-gw-gw-proc s)))))) - -(defun tramp-gw-process-filter (proc string) - (let ((tramp-verbose 0)) - ;; The other process might have been stopped already. We don't - ;; want to be interrupted then. - (ignore-errors - (process-send-string - (tramp-get-connection-property proc "process" nil) string)))) - -;;;###tramp-autoload -(defun tramp-gw-open-connection (vec gw-vec target-vec) - "Open a remote connection to VEC (see `tramp-file-name' structure). -Take GW-VEC as SOCKS or HTTP gateway, i.e. its method must be a -gateway method. TARGET-VEC identifies where to connect to via -the gateway, it can be different from VEC when there are more -hops to be applied. - -It returns a string like \"localhost#port\", which must be used -instead of the host name declared in TARGET-VEC." - - ;; Remember vectors for property retrieval. - (setq tramp-gw-vector vec - tramp-gw-gw-vector gw-vec) - - ;; Start listening auxiliary process. - (unless (and (processp tramp-gw-aux-proc) - (memq (process-status tramp-gw-aux-proc) '(listen))) - (let ((aux-vec - (vector "aux" (tramp-file-name-user gw-vec) - (tramp-file-name-host gw-vec) nil nil))) - (setq tramp-gw-aux-proc - (make-network-process - :name (tramp-buffer-name aux-vec) :buffer nil :host 'local - :server t :noquery t :service t :coding 'binary)) - (set-process-sentinel tramp-gw-aux-proc 'tramp-gw-aux-proc-sentinel) - (tramp-compat-set-process-query-on-exit-flag tramp-gw-aux-proc nil) - (tramp-message - vec 4 "Opening auxiliary process `%s', listening on port %d" - tramp-gw-aux-proc (process-contact tramp-gw-aux-proc :service)))) - - (let* ((gw-method - (intern - (tramp-find-method - (tramp-file-name-method gw-vec) - (tramp-file-name-user gw-vec) - (tramp-file-name-host gw-vec)))) - (socks-username - (tramp-find-user - (tramp-file-name-method gw-vec) - (tramp-file-name-user gw-vec) - (tramp-file-name-host gw-vec))) - ;; Declare the SOCKS server to be used. - (socks-server - (list "Tramp temporary socks server list" - ;; Host name. - (tramp-file-name-real-host gw-vec) - ;; Port number. - (or (tramp-file-name-port gw-vec) - (case gw-method - (tunnel tramp-gw-default-tunnel-port) - (socks tramp-gw-default-socks-port))) - ;; Type. We support only http and socks5, NO socks4. - ;; 'http could be used when HTTP tunnel works in socks.el. - 5)) - ;; The function to be called. - (socks-function - (case gw-method - (tunnel 'tramp-gw-open-network-stream) - (socks 'socks-open-network-stream))) - socks-noproxy) - - ;; Open SOCKS process. - (setq tramp-gw-gw-proc - (funcall - socks-function - (let ((tramp-verbose 0)) (tramp-get-connection-name gw-vec)) - (let ((tramp-verbose 0)) (tramp-get-connection-buffer gw-vec)) - (tramp-file-name-real-host target-vec) - (tramp-file-name-port target-vec))) - (set-process-sentinel tramp-gw-gw-proc 'tramp-gw-gw-proc-sentinel) - (set-process-coding-system tramp-gw-gw-proc 'binary 'binary) - (tramp-compat-set-process-query-on-exit-flag tramp-gw-gw-proc nil) - (tramp-message - vec 4 "Opened %s process `%s'" - (case gw-method ('tunnel "HTTP tunnel") ('socks "SOCKS")) - tramp-gw-gw-proc) - - ;; Return the new host for gateway access. - (format "localhost#%d" (process-contact tramp-gw-aux-proc :service)))) - -(defun tramp-gw-open-network-stream (name buffer host service) - "Open stream to proxy server HOST:SERVICE. -Resulting process has name NAME and buffer BUFFER. If -authentication is requested from proxy server, provide it." - (let ((command (format (concat - "CONNECT %s:%d HTTP/1.1\r\n" - "Host: %s:%d\r\n" - "Connection: keep-alive\r\n" - "User-Agent: Tramp/%s\r\n") - host service host service tramp-version)) - (authentication "") - (first t) - found proc) - - (while (not found) - ;; Clean up. - (when (processp proc) (delete-process proc)) - (with-current-buffer buffer (erase-buffer)) - ;; Open network stream. - (setq proc (open-network-stream - name buffer (nth 1 socks-server) (nth 2 socks-server))) - (set-process-coding-system proc 'binary 'binary) - (tramp-compat-set-process-query-on-exit-flag proc nil) - ;; Send CONNECT command. - (process-send-string proc (format "%s%s\r\n" command authentication)) - (tramp-message - tramp-gw-vector 6 "\n%s" - (format - "%s%s\r\n" command - (tramp-compat-replace-regexp-in-string ;; no password in trace! - "Basic [^\r\n]+" "Basic xxxxx" authentication t))) - (with-current-buffer buffer - ;; Trap errors to be traced in the right trace buffer. Often, - ;; proxies have a timeout of 60". We wait 65" in order to - ;; receive an answer this case. - (ignore-errors - (let ((tramp-verbose 0)) - (tramp-wait-for-regexp proc 65 "\r?\n\r?\n"))) - ;; Check return code. - (goto-char (point-min)) - (narrow-to-region - (point-min) - (or (search-forward-regexp "\r?\n\r?\n" nil t) (point-max))) - (tramp-message tramp-gw-vector 6 "\n%s" (buffer-string)) - (goto-char (point-min)) - (search-forward-regexp "^HTTP/[1-9]\\.[0-9]" nil t) - (case (condition-case nil (read (current-buffer)) (error)) - ;; Connected. - (200 (setq found t)) - ;; We need basic authentication. - (401 (setq authentication (tramp-gw-basic-authentication nil first))) - ;; Access forbidden. - (403 (tramp-error-with-buffer - (current-buffer) tramp-gw-vector 'file-error - "Connection to %s:%d forbidden." host service)) - ;; Target host not found. - (404 (tramp-error-with-buffer - (current-buffer) tramp-gw-vector 'file-error - "Host %s not found." host)) - ;; We need basic proxy authentication. - (407 (setq authentication (tramp-gw-basic-authentication t first))) - ;; Connection failed. - (503 (tramp-error-with-buffer - (current-buffer) tramp-gw-vector 'file-error - "Connection to %s:%d failed." host service)) - ;; That doesn't work at all. - (t (tramp-error-with-buffer - (current-buffer) tramp-gw-vector 'file-error - "Access to HTTP server %s:%d failed." - (nth 1 socks-server) (nth 2 socks-server)))) - ;; Remove HTTP headers. - (delete-region (point-min) (point-max)) - (widen) - (setq first nil))) - ;; Return the process. - proc)) - -(defun tramp-gw-basic-authentication (proxy pw-cache) - "Return authentication header for CONNECT, based on server request. -PROXY is an indication whether we need a Proxy-Authorization header -or an Authorization header. If PW-CACHE is non-nil, check for -password in password cache. This is done for the first try only." - - ;; `tramp-current-*' must be set for `tramp-read-passwd'. - (let ((tramp-current-method (tramp-file-name-method tramp-gw-gw-vector)) - (tramp-current-user (tramp-file-name-user tramp-gw-gw-vector)) - (tramp-current-host (tramp-file-name-host tramp-gw-gw-vector))) - (unless pw-cache (tramp-clear-passwd tramp-gw-gw-vector)) - ;; We are already in the right buffer. - (tramp-message - tramp-gw-vector 5 "%s required" - (if proxy "Proxy authentication" "Authentication")) - ;; Search for request header. We accept only basic authentication. - (goto-char (point-min)) - (search-forward-regexp - "^\\(Proxy\\|WWW\\)-Authenticate:\\s-*Basic\\s-+realm=") - ;; Return authentication string. - (format - "%s: Basic %s\r\n" - (if proxy "Proxy-Authorization" "Authorization") - (base64-encode-string - (format - "%s:%s" - socks-username - (tramp-read-passwd - nil - (format - "Password for %s@[%s]: " socks-username (read (current-buffer))))))))) - -(add-hook 'tramp-unload-hook - (lambda () - (unload-feature 'tramp-gw 'force))) - -(provide 'tramp-gw) - -;;; TODO: - -;; * Provide descriptive Commentary. -;; * Enable it for several gateway processes in parallel. - -;;; tramp-gw.el ends here commit 3b878455ac95ab5b3554642e84d186b4e6cb6a56 Author: Michael Albinus Date: Sun Jan 1 12:59:58 2017 +0100 ; Fix typo * src/gfilenotify.c: diff --git a/src/gfilenotify.c b/src/gfilenotify.c index 9f828375a7..6ec5c64282 100644 --- a/src/gfilenotify.c +++ b/src/gfilenotify.c @@ -27,7 +27,7 @@ along with GNU Emacs. If not, see . */ #include "keyboard.h" -/* This is a list, elements are triples (DESCRIPTOR FILE FLAGS CALLBACK) */ +/* This is a list, elements are quadruples (DESCRIPTOR FILE FLAGS CALLBACK) */ static Lisp_Object watch_list; /* This is the callback function for arriving signals from commit 65eee8392ff95f58f7b0bd036e1fe065523658c6 Author: Paul Eggert Date: Sun Jan 1 02:33:29 2017 -0800 Do not use Gnulib’s m4/wint_t.m4. * admin/merge-gnulib: Remove m4/wint_t.m4 when merging. Fix typo so that warn-on-use.m4 is removed too. * configure.ac (gt_TYPE_WINT_T): New macro, replacing Gnulib’s. * m4/wint_t.m4: Remove. diff --git a/admin/merge-gnulib b/admin/merge-gnulib index 69db30cc41..20a3240ea8 100755 --- a/admin/merge-gnulib +++ b/admin/merge-gnulib @@ -96,7 +96,7 @@ test -x "$gnulib_srcdir"/gnulib-tool || { "$gnulib_srcdir"/gnulib-tool --dir="$src" $GNULIB_TOOL_FLAGS $GNULIB_MODULES && rm -- "$src"lib/gl_openssl.h "$src"m4/fcntl-o.m4 \ "$src"m4/gl-openssl.m4 \ - "$src"m4/gnulib-cache.m4"$src" m4/warn-on-use.m4 && + "$src"m4/gnulib-cache.m4 "$src"m4/warn-on-use.m4 "$src"m4/wint_t.m4 && cp -- "$gnulib_srcdir"/build-aux/texinfo.tex "$src"doc/misc && cp -- "$gnulib_srcdir"/build-aux/move-if-change "$src"build-aux && { test -z "$src" || cd "$src"; } && diff --git a/configure.ac b/configure.ac index 642cf7b37a..ce386f6c6c 100644 --- a/configure.ac +++ b/configure.ac @@ -792,6 +792,10 @@ ac_func_list=$funcs AC_CHECK_FUNCS_ONCE([putenv]) AC_DEFUN([gl_FUNC_PUTENV], [test "$ac_cv_func_putenv" = yes || REPLACE_PUTENV=1]) +# Emacs does not use the wchar or wctype-h modules. +AC_DEFUN([gt_TYPE_WINT_T], + [GNULIB_OVERRIDES_WINT_T=0 + AC_SUBST([GNULIB_OVERRIDES_WINT_T])]) # Initialize gnulib right after choosing the compiler. dnl Amongst other things, this sets AR and ARFLAGS. diff --git a/m4/wint_t.m4 b/m4/wint_t.m4 deleted file mode 100644 index 65e25a4c38..0000000000 --- a/m4/wint_t.m4 +++ /dev/null @@ -1,62 +0,0 @@ -# wint_t.m4 serial 6 -dnl Copyright (C) 2003, 2007-2017 Free Software Foundation, Inc. -dnl This file is free software; the Free Software Foundation -dnl gives unlimited permission to copy and/or distribute it, -dnl with or without modifications, as long as this notice is preserved. - -dnl From Bruno Haible. -dnl Test whether has the 'wint_t' type and whether gnulib's -dnl or would, if present, override 'wint_t'. -dnl Prerequisite: AC_PROG_CC - -AC_DEFUN([gt_TYPE_WINT_T], -[ - AC_CACHE_CHECK([for wint_t], [gt_cv_c_wint_t], - [AC_COMPILE_IFELSE( - [AC_LANG_PROGRAM( - [[ -/* Tru64 with Desktop Toolkit C has a bug: must be included before - . - BSD/OS 4.0.1 has a bug: , and must be included - before . */ -#include -#include -#include -#include - wint_t foo = (wchar_t)'\0';]], - [[]])], - [gt_cv_c_wint_t=yes], - [gt_cv_c_wint_t=no])]) - if test $gt_cv_c_wint_t = yes; then - AC_DEFINE([HAVE_WINT_T], [1], [Define if you have the 'wint_t' type.]) - - dnl Determine whether gnulib's or would, if present, - dnl override 'wint_t'. - AC_CACHE_CHECK([whether wint_t is too small], - [gl_cv_type_wint_t_too_small], - [AC_COMPILE_IFELSE( - [AC_LANG_PROGRAM([[ -/* Tru64 with Desktop Toolkit C has a bug: must be included before - . - BSD/OS 4.0.1 has a bug: , and must be - included before . */ -#if !(defined __GLIBC__ && !defined __UCLIBC__) -# include -# include -# include -#endif -#include - int verify[sizeof (wint_t) < sizeof (int) ? -1 : 1]; - ]])], - [gl_cv_type_wint_t_too_small=no], - [gl_cv_type_wint_t_too_small=yes])]) - if test $gl_cv_type_wint_t_too_small = yes; then - GNULIB_OVERRIDES_WINT_T=1 - else - GNULIB_OVERRIDES_WINT_T=0 - fi - else - GNULIB_OVERRIDES_WINT_T=0 - fi - AC_SUBST([GNULIB_OVERRIDES_WINT_T]) -]) commit aaf1f4a33c96831b9835574b8bfc6f71ec647fdd Author: Paul Eggert Date: Sun Jan 1 02:04:35 2017 -0800 Merge from gnulib, continued * m4/wint_t.m4: New file, copied from gnulib. diff --git a/m4/wint_t.m4 b/m4/wint_t.m4 new file mode 100644 index 0000000000..65e25a4c38 --- /dev/null +++ b/m4/wint_t.m4 @@ -0,0 +1,62 @@ +# wint_t.m4 serial 6 +dnl Copyright (C) 2003, 2007-2017 Free Software Foundation, Inc. +dnl This file is free software; the Free Software Foundation +dnl gives unlimited permission to copy and/or distribute it, +dnl with or without modifications, as long as this notice is preserved. + +dnl From Bruno Haible. +dnl Test whether has the 'wint_t' type and whether gnulib's +dnl or would, if present, override 'wint_t'. +dnl Prerequisite: AC_PROG_CC + +AC_DEFUN([gt_TYPE_WINT_T], +[ + AC_CACHE_CHECK([for wint_t], [gt_cv_c_wint_t], + [AC_COMPILE_IFELSE( + [AC_LANG_PROGRAM( + [[ +/* Tru64 with Desktop Toolkit C has a bug: must be included before + . + BSD/OS 4.0.1 has a bug: , and must be included + before . */ +#include +#include +#include +#include + wint_t foo = (wchar_t)'\0';]], + [[]])], + [gt_cv_c_wint_t=yes], + [gt_cv_c_wint_t=no])]) + if test $gt_cv_c_wint_t = yes; then + AC_DEFINE([HAVE_WINT_T], [1], [Define if you have the 'wint_t' type.]) + + dnl Determine whether gnulib's or would, if present, + dnl override 'wint_t'. + AC_CACHE_CHECK([whether wint_t is too small], + [gl_cv_type_wint_t_too_small], + [AC_COMPILE_IFELSE( + [AC_LANG_PROGRAM([[ +/* Tru64 with Desktop Toolkit C has a bug: must be included before + . + BSD/OS 4.0.1 has a bug: , and must be + included before . */ +#if !(defined __GLIBC__ && !defined __UCLIBC__) +# include +# include +# include +#endif +#include + int verify[sizeof (wint_t) < sizeof (int) ? -1 : 1]; + ]])], + [gl_cv_type_wint_t_too_small=no], + [gl_cv_type_wint_t_too_small=yes])]) + if test $gl_cv_type_wint_t_too_small = yes; then + GNULIB_OVERRIDES_WINT_T=1 + else + GNULIB_OVERRIDES_WINT_T=0 + fi + else + GNULIB_OVERRIDES_WINT_T=0 + fi + AC_SUBST([GNULIB_OVERRIDES_WINT_T]) +]) commit e6a782ee1af7e9d2fe52c3a8cddaf7f02c1ad150 Author: Paul Eggert Date: Sun Jan 1 01:48:38 2017 -0800 Update copyright year to 2017 in master Run admin/update-copyright in the master branch. This fixes files that were not already fixed in the emacs-25 branch before it was merged here. diff --git a/ChangeLog.3 b/ChangeLog.3 index afd8de5a16..835ee08ba0 100644 --- a/ChangeLog.3 +++ b/ChangeLog.3 @@ -22606,7 +22606,7 @@ See ChangeLog.1 for earlier changes. ;; coding: utf-8 ;; End: - Copyright (C) 2015-2016 Free Software Foundation, Inc. + Copyright (C) 2015-2017 Free Software Foundation, Inc. This file is part of GNU Emacs. diff --git a/admin/last-chance.el b/admin/last-chance.el index 02df7dea81..cab2d4718d 100644 --- a/admin/last-chance.el +++ b/admin/last-chance.el @@ -1,6 +1,6 @@ ;;; last-chance.el --- dangling deterrence -*- lexical-binding: t; -*- -;; Copyright (C) 2016 Free Software Foundation, Inc. +;; Copyright (C) 2016-2017 Free Software Foundation, Inc. ;; Author: Thien-Thi Nguyen ;; Maintainer: emacs-devel@gnu.org diff --git a/admin/ldefs-clean.el b/admin/ldefs-clean.el index 89c77a750e..6eabe57c7e 100644 --- a/admin/ldefs-clean.el +++ b/admin/ldefs-clean.el @@ -1,4 +1,4 @@ -;; Copyright (C) 2016 Free Software Foundation, Inc. +;; Copyright (C) 2016-2017 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. diff --git a/doc/lispref/threads.texi b/doc/lispref/threads.texi index de1c27bf18..d6cf99d233 100644 --- a/doc/lispref/threads.texi +++ b/doc/lispref/threads.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 2012-2016 Free Software Foundation, Inc. +@c Copyright (C) 2012-2017 Free Software Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Threads @chapter Threads diff --git a/etc/NEWS.25 b/etc/NEWS.25 index f679243190..c5e95d37c8 100644 --- a/etc/NEWS.25 +++ b/etc/NEWS.25 @@ -1,6 +1,6 @@ GNU Emacs NEWS -- history of user-visible changes. -Copyright (C) 2014-2016 Free Software Foundation, Inc. +Copyright (C) 2014-2017 Free Software Foundation, Inc. See the end of the file for license conditions. Please send Emacs bug reports to bug-gnu-emacs@gnu.org. diff --git a/lib/Makefile.am b/lib/Makefile.am index 316c63725a..e6d90ddd10 100644 --- a/lib/Makefile.am +++ b/lib/Makefile.am @@ -1,4 +1,4 @@ -# Copyright 2016 Free Software Foundation, Inc. +# Copyright 2016-2017 Free Software Foundation, Inc. # This file is part of GNU Emacs. diff --git a/lisp/emacs-lisp/radix-tree.el b/lisp/emacs-lisp/radix-tree.el index 8146bb3c28..b5e7589b95 100644 --- a/lisp/emacs-lisp/radix-tree.el +++ b/lisp/emacs-lisp/radix-tree.el @@ -1,6 +1,6 @@ ;;; radix-tree.el --- A simple library of radix trees -*- lexical-binding: t; -*- -;; Copyright (C) 2016 Free Software Foundation, Inc. +;; Copyright (C) 2016-2017 Free Software Foundation, Inc. ;; Author: Stefan Monnier ;; Keywords: diff --git a/lisp/emacs-lisp/timer-list.el b/lisp/emacs-lisp/timer-list.el index 9b13e52dd7..1a38254bcb 100644 --- a/lisp/emacs-lisp/timer-list.el +++ b/lisp/emacs-lisp/timer-list.el @@ -1,6 +1,6 @@ ;;; timer-list.el --- list active timers in a buffer -;; Copyright (C) 2016 Free Software Foundation, Inc. +;; Copyright (C) 2016-2017 Free Software Foundation, Inc. ;; Maintainer: emacs-devel@gnu.org ;; Package: emacs diff --git a/lisp/gnus/gnus-rfc1843.el b/lisp/gnus/gnus-rfc1843.el index 4e6fdc6d87..a47e19b8f0 100644 --- a/lisp/gnus/gnus-rfc1843.el +++ b/lisp/gnus/gnus-rfc1843.el @@ -1,6 +1,6 @@ ;;; gnus-rfc1843.el --- HZ (rfc1843) decoding interface functions for Gnus -;; Copyright (C) 1998-2016 Free Software Foundation, Inc. +;; Copyright (C) 1998-2017 Free Software Foundation, Inc. ;; Author: Shenghuo Zhu ;; Keywords: news HZ HZ+ mail i18n diff --git a/lisp/net/puny.el b/lisp/net/puny.el index 50bde85287..c718d958be 100644 --- a/lisp/net/puny.el +++ b/lisp/net/puny.el @@ -1,6 +1,6 @@ ;;; puny.el --- translate non-ASCII domain names to ASCII -;; Copyright (C) 2015-2016 Free Software Foundation, Inc. +;; Copyright (C) 2015-2017 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: mail, net diff --git a/lisp/obsolete/messcompat.el b/lisp/obsolete/messcompat.el index faebcc84cb..46adf83600 100644 --- a/lisp/obsolete/messcompat.el +++ b/lisp/obsolete/messcompat.el @@ -1,6 +1,6 @@ ;;; messcompat.el --- making message mode compatible with mail mode -;; Copyright (C) 1996-2016 Free Software Foundation, Inc. +;; Copyright (C) 1996-2017 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: mail, news diff --git a/lisp/svg.el b/lisp/svg.el index a92c6dfb61..65e031b387 100644 --- a/lisp/svg.el +++ b/lisp/svg.el @@ -1,6 +1,6 @@ ;;; svg.el --- SVG image creation functions -*- lexical-binding: t -*- -;; Copyright (C) 2016 Free Software Foundation, Inc. +;; Copyright (C) 2016-2017 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: image diff --git a/nt/inc/sys/resource.h b/nt/inc/sys/resource.h index dfa0318cb4..2964a643d3 100644 --- a/nt/inc/sys/resource.h +++ b/nt/inc/sys/resource.h @@ -1,6 +1,6 @@ /* A limited emulation of sys/resource.h. -Copyright (C) 2016 Free Software Foundation, Inc. +Copyright (C) 2016-2017 Free Software Foundation, Inc. This file is part of GNU Emacs. diff --git a/src/sheap.h b/src/sheap.h index c229a1b06e..023db8c0fc 100644 --- a/src/sheap.h +++ b/src/sheap.h @@ -1,6 +1,6 @@ /* Static heap allocation for GNU Emacs. -Copyright 2016 Free Software Foundation, Inc. +Copyright 2016-2017 Free Software Foundation, Inc. This file is part of GNU Emacs. diff --git a/src/systhread.c b/src/systhread.c index a2c556fd8e..a1b3eae64a 100644 --- a/src/systhread.c +++ b/src/systhread.c @@ -1,5 +1,5 @@ /* System thread definitions -Copyright (C) 2012-2016 Free Software Foundation, Inc. +Copyright (C) 2012-2017 Free Software Foundation, Inc. This file is part of GNU Emacs. diff --git a/src/systhread.h b/src/systhread.h index ffe2998c23..c007d3ceb5 100644 --- a/src/systhread.h +++ b/src/systhread.h @@ -1,5 +1,5 @@ /* System thread definitions -Copyright (C) 2012-2016 Free Software Foundation, Inc. +Copyright (C) 2012-2017 Free Software Foundation, Inc. This file is part of GNU Emacs. diff --git a/src/thread.c b/src/thread.c index 9a1198a0cc..01e8aa736c 100644 --- a/src/thread.c +++ b/src/thread.c @@ -1,5 +1,5 @@ /* Threading code. -Copyright (C) 2012-2016 Free Software Foundation, Inc. +Copyright (C) 2012-2017 Free Software Foundation, Inc. This file is part of GNU Emacs. diff --git a/src/thread.h b/src/thread.h index e6dc668f95..9e94de5c17 100644 --- a/src/thread.h +++ b/src/thread.h @@ -1,5 +1,5 @@ /* Thread definitions -Copyright (C) 2012-2016 Free Software Foundation, Inc. +Copyright (C) 2012-2017 Free Software Foundation, Inc. This file is part of GNU Emacs. diff --git a/test/lisp/abbrev-tests.el b/test/lisp/abbrev-tests.el index c747e19db8..a454471ae3 100644 --- a/test/lisp/abbrev-tests.el +++ b/test/lisp/abbrev-tests.el @@ -1,6 +1,6 @@ ;;; abbrev-tests.el --- Test suite for abbrevs -*- lexical-binding: t; -*- -;; Copyright (C) 2015-2016 Free Software Foundation, Inc. +;; Copyright (C) 2015-2017 Free Software Foundation, Inc. ;; Author: Eli Zaretskii ;; Keywords: abbrevs diff --git a/test/lisp/buff-menu-tests.el b/test/lisp/buff-menu-tests.el index 5bfdfba7a2..43214f2506 100644 --- a/test/lisp/buff-menu-tests.el +++ b/test/lisp/buff-menu-tests.el @@ -1,6 +1,6 @@ ;;; buff-menu-tests.el --- Test suite for buff-menu.el -*- lexical-binding: t -*- -;; Copyright (C) 2016 Free Software Foundation, Inc. +;; Copyright (C) 2016-2017 Free Software Foundation, Inc. ;; Author: Tino Calancha diff --git a/test/lisp/calendar/parse-time-tests.el b/test/lisp/calendar/parse-time-tests.el index 6dc23372f2..26b4e9e44d 100644 --- a/test/lisp/calendar/parse-time-tests.el +++ b/test/lisp/calendar/parse-time-tests.el @@ -1,6 +1,6 @@ ;; parse-time-tests.el --- Test suite for parse-time.el -;; Copyright (C) 2016 Free Software Foundation, Inc. +;; Copyright (C) 2016-2017 Free Software Foundation, Inc. ;; Author: Lars Ingebrigtsen diff --git a/test/lisp/dired-tests.el b/test/lisp/dired-tests.el index 6dd4bb91bc..489f8fdfea 100644 --- a/test/lisp/dired-tests.el +++ b/test/lisp/dired-tests.el @@ -1,6 +1,6 @@ ;;; dired-tests.el --- Test suite. -*- lexical-binding: t -*- -;; Copyright (C) 2015-2016 Free Software Foundation, Inc. +;; Copyright (C) 2015-2017 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. diff --git a/test/lisp/dom-tests.el b/test/lisp/dom-tests.el index ca6bfbf84b..09114bd794 100644 --- a/test/lisp/dom-tests.el +++ b/test/lisp/dom-tests.el @@ -1,6 +1,6 @@ ;;; dom-tests.el --- Tests for dom.el -*- lexical-binding: t; -*- -;; Copyright (C) 2016 Free Software Foundation, Inc. +;; Copyright (C) 2016-2017 Free Software Foundation, Inc. ;; Author: Simen Heggestøyl ;; Keywords: diff --git a/test/lisp/emacs-lisp/checkdoc-tests.el b/test/lisp/emacs-lisp/checkdoc-tests.el index 02db88c17e..ac1375e1d3 100644 --- a/test/lisp/emacs-lisp/checkdoc-tests.el +++ b/test/lisp/emacs-lisp/checkdoc-tests.el @@ -1,6 +1,6 @@ ;;; checkdoc-tests.el --- unit tests for checkdoc.el -*- lexical-binding: t; -*- -;; Copyright (C) 2016 Free Software Foundation, Inc. +;; Copyright (C) 2016-2017 Free Software Foundation, Inc. ;; Author: Google Inc. diff --git a/test/lisp/emacs-lisp/cl-seq-tests.el b/test/lisp/emacs-lisp/cl-seq-tests.el index 02d9246db2..3740b5c183 100644 --- a/test/lisp/emacs-lisp/cl-seq-tests.el +++ b/test/lisp/emacs-lisp/cl-seq-tests.el @@ -1,6 +1,6 @@ ;;; cl-seq-tests.el --- Tests for cl-seq.el functionality -*- lexical-binding: t; -*- -;; Copyright (C) 2015-2016 Free Software Foundation, Inc. +;; Copyright (C) 2015-2017 Free Software Foundation, Inc. ;; Author: Nicolas Richard diff --git a/test/lisp/emacs-lisp/lisp-tests.el b/test/lisp/emacs-lisp/lisp-tests.el index 2dadae9553..8cba7fc526 100644 --- a/test/lisp/emacs-lisp/lisp-tests.el +++ b/test/lisp/emacs-lisp/lisp-tests.el @@ -1,6 +1,6 @@ ;;; lisp-tests.el --- Test Lisp editing commands -*- lexical-binding: t; -*- -;; Copyright (C) 2013-2016 Free Software Foundation, Inc. +;; Copyright (C) 2013-2017 Free Software Foundation, Inc. ;; Author: Aaron S. Hawley ;; Author: Stefan Monnier diff --git a/test/lisp/emacs-lisp/ring-tests.el b/test/lisp/emacs-lisp/ring-tests.el index affde8914b..c869f9dc87 100644 --- a/test/lisp/emacs-lisp/ring-tests.el +++ b/test/lisp/emacs-lisp/ring-tests.el @@ -1,6 +1,6 @@ ;;; ring-tests.el --- Tests for ring.el -*- lexical-binding: t; -*- -;; Copyright (C) 2016 Free Software Foundation, Inc. +;; Copyright (C) 2016-2017 Free Software Foundation, Inc. ;; Author: Simen Heggestøyl ;; Keywords: diff --git a/test/lisp/emacs-lisp/rx-tests.el b/test/lisp/emacs-lisp/rx-tests.el index 7ff45f650c..8b7945c9d2 100644 --- a/test/lisp/emacs-lisp/rx-tests.el +++ b/test/lisp/emacs-lisp/rx-tests.el @@ -1,6 +1,6 @@ ;;; rx-tests.el --- test for rx.el functions -*- lexical-binding: t -*- -;; Copyright (C) 2016 Free Software Foundation, Inc. +;; Copyright (C) 2016-2017 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. diff --git a/test/lisp/erc/erc-track-tests.el b/test/lisp/erc/erc-track-tests.el index 7cf3ef7bb2..da119ed4b1 100644 --- a/test/lisp/erc/erc-track-tests.el +++ b/test/lisp/erc/erc-track-tests.el @@ -1,6 +1,6 @@ ;;; erc-track-tests.el --- Tests for erc-track. -;; Copyright (C) 2016 Free Software Foundation, Inc. +;; Copyright (C) 2016-2017 Free Software Foundation, Inc. ;; Author: Mario Lang ;; Author: Vivek Dasmohapatra diff --git a/test/lisp/ffap-tests.el b/test/lisp/ffap-tests.el index 61fa891fe7..1ba5f86a88 100644 --- a/test/lisp/ffap-tests.el +++ b/test/lisp/ffap-tests.el @@ -1,6 +1,6 @@ ;;; ffap-tests.el --- Test suite for ffap.el -*- lexical-binding: t -*- -;; Copyright (C) 2016 Free Software Foundation, Inc. +;; Copyright (C) 2016-2017 Free Software Foundation, Inc. ;; Author: Tino Calancha diff --git a/test/lisp/files-x-tests.el b/test/lisp/files-x-tests.el index 8f2c11d391..88b58fe957 100644 --- a/test/lisp/files-x-tests.el +++ b/test/lisp/files-x-tests.el @@ -1,6 +1,6 @@ ;;; files-x-tests.el --- tests for files-x.el. -;; Copyright (C) 2016 Free Software Foundation, Inc. +;; Copyright (C) 2016-2017 Free Software Foundation, Inc. ;; Author: Michael Albinus diff --git a/test/lisp/help-fns-tests.el b/test/lisp/help-fns-tests.el index ba0d8ed8e3..0ab6c3cae7 100644 --- a/test/lisp/help-fns-tests.el +++ b/test/lisp/help-fns-tests.el @@ -1,6 +1,6 @@ ;;; help-fns.el --- tests for help-fns.el -;; Copyright (C) 2014-2016 Free Software Foundation, Inc. +;; Copyright (C) 2014-2017 Free Software Foundation, Inc. ;; Maintainer: emacs-devel@gnu.org diff --git a/test/lisp/htmlfontify-tests.el b/test/lisp/htmlfontify-tests.el index 012e170f4d..15eb7c170c 100644 --- a/test/lisp/htmlfontify-tests.el +++ b/test/lisp/htmlfontify-tests.el @@ -1,6 +1,6 @@ ;;; htmlfontify-tests.el --- Test suite. -*- lexical-binding: t -*- -;; Copyright (C) 2015-2016 Free Software Foundation, Inc. +;; Copyright (C) 2015-2017 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. diff --git a/test/lisp/ibuffer-tests.el b/test/lisp/ibuffer-tests.el index 40760abd96..fb632e2073 100644 --- a/test/lisp/ibuffer-tests.el +++ b/test/lisp/ibuffer-tests.el @@ -1,6 +1,6 @@ ;;; ibuffer-tests.el --- Test suite. -*- lexical-binding: t -*- -;; Copyright (C) 2015-2016 Free Software Foundation, Inc. +;; Copyright (C) 2015-2017 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. diff --git a/test/lisp/international/ucs-normalize-tests.el b/test/lisp/international/ucs-normalize-tests.el index 42cf805b77..d85efe2d7b 100644 --- a/test/lisp/international/ucs-normalize-tests.el +++ b/test/lisp/international/ucs-normalize-tests.el @@ -1,6 +1,6 @@ ;;; ucs-normalize --- tests for international/ucs-normalize.el -*- lexical-binding: t -*- -;; Copyright (C) 2002-2016 Free Software Foundation, Inc. +;; Copyright (C) 2002-2017 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. diff --git a/test/lisp/jit-lock-tests.el b/test/lisp/jit-lock-tests.el index dcb6936e32..22d1e015db 100644 --- a/test/lisp/jit-lock-tests.el +++ b/test/lisp/jit-lock-tests.el @@ -1,6 +1,6 @@ ;;; jit-lock-tests.el --- tests for jit-lock -;; Copyright (C) 2016 Free Software Foundation, Inc. +;; Copyright (C) 2016-2017 Free Software Foundation, Inc. ;; Author: Dmitry Gutov diff --git a/test/lisp/mouse-tests.el b/test/lisp/mouse-tests.el index 204f5d3b8d..fffaa2fa53 100644 --- a/test/lisp/mouse-tests.el +++ b/test/lisp/mouse-tests.el @@ -1,6 +1,6 @@ ;;; mouse-tests.el --- unit tests for mouse.el -*- lexical-binding: t; -*- -;; Copyright (C) 2016 Free Software Foundation, Inc. +;; Copyright (C) 2016-2017 Free Software Foundation, Inc. ;; Author: Philipp Stephani diff --git a/test/lisp/net/network-stream-tests.el b/test/lisp/net/network-stream-tests.el index afffeeb193..b237fea3dd 100644 --- a/test/lisp/net/network-stream-tests.el +++ b/test/lisp/net/network-stream-tests.el @@ -1,6 +1,6 @@ ;;; network-stream-tests.el --- tests for network processes -*- lexical-binding: t; -*- -;; Copyright (C) 2016 Free Software Foundation, Inc. +;; Copyright (C) 2016-2017 Free Software Foundation, Inc. ;; Author: Lars Ingebrigtsen diff --git a/test/lisp/net/shr-tests.el b/test/lisp/net/shr-tests.el index 501916fc8b..c82338af73 100644 --- a/test/lisp/net/shr-tests.el +++ b/test/lisp/net/shr-tests.el @@ -1,6 +1,6 @@ ;;; network-stream-tests.el --- tests for network processes -*- lexical-binding: t; -*- -;; Copyright (C) 2016 Free Software Foundation, Inc. +;; Copyright (C) 2016-2017 Free Software Foundation, Inc. ;; Author: Lars Ingebrigtsen diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 22b60db04f..02e5d18b7f 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -1,6 +1,6 @@ ;;; tramp-tests.el --- Tests of remote file access -;; Copyright (C) 2013-2016 Free Software Foundation, Inc. +;; Copyright (C) 2013-2017 Free Software Foundation, Inc. ;; Author: Michael Albinus diff --git a/test/lisp/progmodes/cc-mode-tests.el b/test/lisp/progmodes/cc-mode-tests.el index 62e0a738fb..10f424f528 100644 --- a/test/lisp/progmodes/cc-mode-tests.el +++ b/test/lisp/progmodes/cc-mode-tests.el @@ -1,6 +1,6 @@ ;;; cc-mode-tests.el --- Test suite for cc-mode. -*- lexical-binding: t; -*- -;; Copyright (C) 2016 Free Software Foundation, Inc. +;; Copyright (C) 2016-2017 Free Software Foundation, Inc. ;; Author: Michal Nazarewicz ;; Keywords: internal diff --git a/test/lisp/progmodes/etags-tests.el b/test/lisp/progmodes/etags-tests.el index a992a17dc4..eec8a02f1b 100644 --- a/test/lisp/progmodes/etags-tests.el +++ b/test/lisp/progmodes/etags-tests.el @@ -1,6 +1,6 @@ ;;; etags-tests.el --- Test suite for etags.el. -;; Copyright (C) 2016 Free Software Foundation, Inc. +;; Copyright (C) 2016-2017 Free Software Foundation, Inc. ;; Author: Eli Zaretskii diff --git a/test/lisp/progmodes/sql-tests.el b/test/lisp/progmodes/sql-tests.el index e05247a60e..27a72aa2c2 100644 --- a/test/lisp/progmodes/sql-tests.el +++ b/test/lisp/progmodes/sql-tests.el @@ -1,6 +1,6 @@ ;;; sql-tests.el --- Tests for sql.el -*- lexical-binding: t; -*- -;; Copyright (C) 2016 Free Software Foundation, Inc. +;; Copyright (C) 2016-2017 Free Software Foundation, Inc. ;; Author: Simen Heggestøyl ;; Keywords: diff --git a/test/lisp/ps-print-tests.el b/test/lisp/ps-print-tests.el index 9ebd31b746..e1df37b645 100644 --- a/test/lisp/ps-print-tests.el +++ b/test/lisp/ps-print-tests.el @@ -1,6 +1,6 @@ ;;; ps-print-tests.el --- Test suite for ps-print.el -*- lexical-binding: t; -*- -;; Copyright (C) 2015-2016 Free Software Foundation, Inc. +;; Copyright (C) 2015-2017 Free Software Foundation, Inc. ;; Author: Phillip Lord diff --git a/test/lisp/rot13-tests.el b/test/lisp/rot13-tests.el index a31dc50f8f..70fe34510d 100644 --- a/test/lisp/rot13-tests.el +++ b/test/lisp/rot13-tests.el @@ -1,6 +1,6 @@ ;;; rot13-tests.el --- Tests for rot13.el -*- lexical-binding: t; -*- -;; Copyright (C) 2016 Free Software Foundation, Inc. +;; Copyright (C) 2016-2017 Free Software Foundation, Inc. ;; Author: Simen Heggestøyl ;; Keywords: diff --git a/test/lisp/shell-tests.el b/test/lisp/shell-tests.el index be8f7d5c13..6eb9cdcdd1 100644 --- a/test/lisp/shell-tests.el +++ b/test/lisp/shell-tests.el @@ -1,6 +1,6 @@ ;;; shell-tests.el -*- lexical-binding:t -*- -;; Copyright (C) 2010-2016 Free Software Foundation, Inc. +;; Copyright (C) 2010-2017 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. diff --git a/test/lisp/textmodes/css-mode-tests.el b/test/lisp/textmodes/css-mode-tests.el index f92ac11114..6eb32ea7fc 100644 --- a/test/lisp/textmodes/css-mode-tests.el +++ b/test/lisp/textmodes/css-mode-tests.el @@ -1,6 +1,6 @@ ;;; css-mode-tests.el --- Test suite for CSS mode -*- lexical-binding: t; -*- -;; Copyright (C) 2016 Free Software Foundation, Inc. +;; Copyright (C) 2016-2017 Free Software Foundation, Inc. ;; Author: Simen Heggestøyl ;; Keywords: internal diff --git a/test/lisp/url/url-auth-tests.el b/test/lisp/url/url-auth-tests.el index bc30f3518e..11e5a47972 100644 --- a/test/lisp/url/url-auth-tests.el +++ b/test/lisp/url/url-auth-tests.el @@ -1,6 +1,6 @@ ;;; url-auth-tests.el --- Test suite for url-auth. -;; Copyright (C) 2015-2016 Free Software Foundation, Inc. +;; Copyright (C) 2015-2017 Free Software Foundation, Inc. ;; Author: Jarno Malmari diff --git a/test/lisp/vc/ediff-ptch-tests.el b/test/lisp/vc/ediff-ptch-tests.el index 427423a740..912c6b1e81 100644 --- a/test/lisp/vc/ediff-ptch-tests.el +++ b/test/lisp/vc/ediff-ptch-tests.el @@ -1,6 +1,6 @@ ;;; ediff-ptch-tests.el --- Tests for ediff-ptch.el -;; Copyright (C) 2016 Free Software Foundation, Inc. +;; Copyright (C) 2016-2017 Free Software Foundation, Inc. ;; Author: Tino Calancha diff --git a/test/lisp/whitespace-tests.el b/test/lisp/whitespace-tests.el index ffd2e65d9a..99cc3c4ec0 100644 --- a/test/lisp/whitespace-tests.el +++ b/test/lisp/whitespace-tests.el @@ -1,6 +1,6 @@ ;;; whitespace-tests.el --- Test suite for whitespace -*- lexical-binding: t -*- -;; Copyright (C) 2016 Free Software Foundation, Inc. +;; Copyright (C) 2016-2017 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. diff --git a/test/make-test-deps.emacs-lisp b/test/make-test-deps.emacs-lisp index 9edeef3d2a..609e927618 100644 --- a/test/make-test-deps.emacs-lisp +++ b/test/make-test-deps.emacs-lisp @@ -1,6 +1,6 @@ ;; -*- emacs-lisp -*- -;; Copyright (C) 2015-2016 Free Software Foundation, Inc. +;; Copyright (C) 2015-2017 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. diff --git a/test/src/callproc-tests.el b/test/src/callproc-tests.el index 46541aba78..853d56e827 100644 --- a/test/src/callproc-tests.el +++ b/test/src/callproc-tests.el @@ -1,6 +1,6 @@ ;;; callproc-tests.el --- callproc.c tests -*- lexical-binding: t -*- -;; Copyright (C) 2016 Free Software Foundation, Inc. +;; Copyright (C) 2016-2017 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. diff --git a/test/src/chartab-tests.el b/test/src/chartab-tests.el index 016ddcdde6..54fcdcffba 100644 --- a/test/src/chartab-tests.el +++ b/test/src/chartab-tests.el @@ -1,6 +1,6 @@ ;;; chartab-tests.el --- Tests for char-tab.c -;; Copyright (C) 2016 Free Software Foundation, Inc. +;; Copyright (C) 2016-2017 Free Software Foundation, Inc. ;; Author: Eli Zaretskii diff --git a/test/src/data-tests.el b/test/src/data-tests.el index 757522e399..2e4a6aa2e8 100644 --- a/test/src/data-tests.el +++ b/test/src/data-tests.el @@ -1,6 +1,6 @@ ;;; data-tests.el --- tests for src/data.c -;; Copyright (C) 2013-2016 Free Software Foundation, Inc. +;; Copyright (C) 2013-2017 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. diff --git a/test/src/doc-tests.el b/test/src/doc-tests.el index be49054574..8e5446e2a4 100644 --- a/test/src/doc-tests.el +++ b/test/src/doc-tests.el @@ -1,6 +1,6 @@ ;;; doc-tests.el --- Tests for doc.c -;; Copyright (C) 2016 Free Software Foundation, Inc. +;; Copyright (C) 2016-2017 Free Software Foundation, Inc. ;; Author: Eli Zaretskii diff --git a/test/src/editfns-tests.el b/test/src/editfns-tests.el index 2f90d1e749..7b4f41aab5 100644 --- a/test/src/editfns-tests.el +++ b/test/src/editfns-tests.el @@ -1,6 +1,6 @@ ;;; editfns-tests.el -- tests for editfns.c -;; Copyright (C) 2016 Free Software Foundation, Inc. +;; Copyright (C) 2016-2017 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. diff --git a/test/src/eval-tests.el b/test/src/eval-tests.el index fe08506ed2..a1fe8ccd7d 100644 --- a/test/src/eval-tests.el +++ b/test/src/eval-tests.el @@ -1,6 +1,6 @@ ;;; eval-tests.el --- unit tests for src/eval.c -*- lexical-binding: t; -*- -;; Copyright (C) 2016 Free Software Foundation, Inc. +;; Copyright (C) 2016-2017 Free Software Foundation, Inc. ;; Author: Philipp Stephani diff --git a/test/src/lread-tests.el b/test/src/lread-tests.el index 609f82ec20..a783afd312 100644 --- a/test/src/lread-tests.el +++ b/test/src/lread-tests.el @@ -1,6 +1,6 @@ ;;; lread-tests.el --- tests for lread.c -*- lexical-binding: t; -*- -;; Copyright (C) 2016 Free Software Foundation, Inc. +;; Copyright (C) 2016-2017 Free Software Foundation, Inc. ;; Author: Philipp Stephani diff --git a/test/src/marker-tests.el b/test/src/marker-tests.el index 18d49addb2..20ce8f4cc0 100644 --- a/test/src/marker-tests.el +++ b/test/src/marker-tests.el @@ -1,6 +1,6 @@ ;;; marker-tests.el --- tests for marker.c functions -*- lexical-binding: t -*- -;; Copyright (C) 2016 Free Software Foundation, Inc. +;; Copyright (C) 2016-2017 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. diff --git a/test/src/minibuf-tests.el b/test/src/minibuf-tests.el index 82ac0373cb..cb14819d34 100644 --- a/test/src/minibuf-tests.el +++ b/test/src/minibuf-tests.el @@ -1,6 +1,6 @@ ;;; minibuf-tests.el --- tests for minibuf.c functions -*- lexical-binding: t -*- -;; Copyright (C) 2016 Free Software Foundation, Inc. +;; Copyright (C) 2016-2017 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. diff --git a/test/src/regex-tests.el b/test/src/regex-tests.el index c4844c7cdb..74c27111cf 100644 --- a/test/src/regex-tests.el +++ b/test/src/regex-tests.el @@ -1,6 +1,6 @@ ;;; regex-tests.el --- tests for regex.c functions -*- lexical-binding: t -*- -;; Copyright (C) 2015-2016 Free Software Foundation, Inc. +;; Copyright (C) 2015-2017 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. diff --git a/test/src/thread-tests.el b/test/src/thread-tests.el index 73da72e836..2e5a3bcc1f 100644 --- a/test/src/thread-tests.el +++ b/test/src/thread-tests.el @@ -1,6 +1,6 @@ ;;; threads.el --- tests for threads. -;; Copyright (C) 2012-2016 Free Software Foundation, Inc. +;; Copyright (C) 2012-2017 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. commit 42479446d3f2973c848f207ea840eeaab519c141 Author: Paul Eggert Date: Sun Jan 1 01:37:30 2017 -0800 Remove test/automated detritus from merge diff --git a/test/automated/abbrev-tests.el b/test/automated/abbrev-tests.el deleted file mode 100644 index 7adab32892..0000000000 --- a/test/automated/abbrev-tests.el +++ /dev/null @@ -1,98 +0,0 @@ -;;; abbrev-tests.el --- Test suite for abbrevs. - -;; Copyright (C) 2015-2017 Free Software Foundation, Inc. - -;; Author: Eli Zaretskii -;; Keywords: abbrevs - -;; 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: - -;; `kill-all-abbrevs-test' will remove all user *and* system abbrevs -;; if called noninteractively with the init file loaded. - -;;; Code: - -(require 'ert) -(require 'abbrev) -(require 'seq) - -;; set up test abbrev table and abbrev entry -(defun setup-test-abbrev-table () - (defvar ert-test-abbrevs nil) - (define-abbrev-table 'ert-test-abbrevs '(("a-e-t" "abbrev-ert-test"))) - (abbrev-table-put ert-test-abbrevs :ert-test "ert-test-value") - ert-test-abbrevs) - -(ert-deftest copy-abbrev-table-test () - (defvar foo-abbrev-table nil) ; Avoid compiler warning - (define-abbrev-table 'foo-abbrev-table - '()) - (should (abbrev-table-p foo-abbrev-table)) - ;; Bug 21828 - (let ((new-foo-abbrev-table - (condition-case nil - (copy-abbrev-table foo-abbrev-table) - (error nil)))) - (should (abbrev-table-p new-foo-abbrev-table))) - (should-not (string-equal (buffer-name) "*Backtrace*"))) - -(ert-deftest kill-all-abbrevs-test () - "Test undefining all defined abbrevs" - (unless noninteractive - (ert-skip "Cannot test kill-all-abbrevs in interactive mode")) - - (let ((num-tables 0)) - ;; ensure at least one abbrev exists - (should (abbrev-table-p (setup-test-abbrev-table))) - (setf num-tables (length abbrev-table-name-list)) - (kill-all-abbrevs) - - ;; no tables should have been removed/added - (should (= num-tables (length abbrev-table-name-list))) - ;; number of empty tables should be the same as number of tables - (should (= num-tables (length (seq-filter - (lambda (table) - (abbrev-table-empty-p (symbol-value table))) - abbrev-table-name-list)))))) - -(ert-deftest abbrev-table-name-test () - "Test returning name of abbrev-table" - (let ((ert-test-abbrevs (setup-test-abbrev-table)) - (no-such-table nil)) - (should (equal 'ert-test-abbrevs (abbrev-table-name ert-test-abbrevs))) - (should (equal nil (abbrev-table-name no-such-table))))) - -(ert-deftest clear-abbrev-table-test () - "Test clearing single abbrev table" - (let ((ert-test-abbrevs (setup-test-abbrev-table))) - (should (equal "a-e-t" (symbol-name - (abbrev-symbol "a-e-t" ert-test-abbrevs)))) - (should (equal "abbrev-ert-test" (symbol-value - (abbrev-symbol "a-e-t" ert-test-abbrevs)))) - - (clear-abbrev-table ert-test-abbrevs) - - (should (equal "nil" (symbol-name - (abbrev-symbol "a-e-t" ert-test-abbrevs)))) - (should (equal nil (symbol-value - (abbrev-symbol "a-e-t" ert-test-abbrevs)))) - (should (equal t (abbrev-table-empty-p ert-test-abbrevs))))) - -(provide 'abbrev-tests) - -;;; abbrev-tests.el ends here diff --git a/test/automated/cl-seq-tests.el b/test/automated/cl-seq-tests.el deleted file mode 100644 index d89bad9bfb..0000000000 --- a/test/automated/cl-seq-tests.el +++ /dev/null @@ -1,42 +0,0 @@ -;;; cl-seq-tests.el --- Tests for cl-seq.el functionality -*- lexical-binding: t; -*- - -;; Copyright (C) 2015-2017 Free Software Foundation, Inc. - -;; Author: Nicolas Richard - -;; 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) -(require 'cl-seq) - -(ert-deftest cl-union-test-00 () - (let ((str1 "foo") - (str2 (make-string 3 ?o))) - ;; Emacs may make two string literals eql when reading. - (aset str2 0 ?f) - (should (not (eql str1 str2))) - (should (equal str1 str2)) - (should (equal (cl-union (list str1) (list str2)) - (list str2))) - (should (equal (cl-union (list str1) (list str2) :test 'eql) - (list str1 str2))))) - -(provide 'cl-seq-tests) -;;; cl-seq-tests.el ends here diff --git a/test/automated/coding-tests.el b/test/automated/coding-tests.el deleted file mode 100644 index c0ad8d555b..0000000000 --- a/test/automated/coding-tests.el +++ /dev/null @@ -1,50 +0,0 @@ -;;; coding-tests.el --- tests for text encoding and decoding - -;; Copyright (C) 2015-2017 Free Software Foundation, Inc. - -;; Author: Eli Zaretskii - -;; 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 . - -;;; Code: - -(require 'ert) - -;; Directory to hold test data files. -(defvar coding-tests-workdir - (expand-file-name "coding-tests" temporary-file-directory)) - -;; Remove all generated test files. -(defun coding-tests-remove-files () - (delete-directory coding-tests-workdir t)) - -(ert-deftest ert-test-coding-bogus-coding-systems () - (unwind-protect - (let (test-file) - (or (file-directory-p coding-tests-workdir) - (mkdir coding-tests-workdir t)) - (setq test-file (expand-file-name "nonexistent" coding-tests-workdir)) - (if (file-exists-p test-file) - (delete-file test-file)) - (should-error - (let ((coding-system-for-read 'bogus)) - (insert-file-contents test-file))) - ;; See bug #21602. - (setq test-file (expand-file-name "writing" coding-tests-workdir)) - (should-error - (let ((coding-system-for-write (intern "\"us-ascii\""))) - (write-region "some text" nil test-file)))) - (coding-tests-remove-files))) diff --git a/test/automated/core-elisp-tests.el b/test/automated/core-elisp-tests.el deleted file mode 100644 index 0851367f9b..0000000000 --- a/test/automated/core-elisp-tests.el +++ /dev/null @@ -1,52 +0,0 @@ -;;; core-elisp-tests.el --- Testing some core Elisp rules - -;; Copyright (C) 2013-2017 Free Software Foundation, Inc. - -;; Author: Stefan Monnier -;; Keywords: - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Commentary: - -;; - -;;; Code: - -(ert-deftest core-elisp-tests-1-defvar-in-let () - "Test some core Elisp rules." - (with-temp-buffer - ;; Check that when defvar is run within a let-binding, the toplevel default - ;; is properly initialized. - (should (equal (list (let ((c-e-x 1)) (defvar c-e-x 2) c-e-x) c-e-x) - '(1 2))) - (should (equal (list (let ((c-e-x 1)) - (defcustom c-e-x 2 "doc" :group 'blah :type 'integer) c-e-x) - c-e-x) - '(1 2))))) - -(ert-deftest core-elisp-tests-2-window-configurations () - "Test properties of window-configurations." - (let ((wc (current-window-configuration))) - (with-current-buffer (window-buffer (frame-selected-window)) - (push-mark) - (activate-mark)) - (set-window-configuration wc) - (should (or (not mark-active) (mark))))) - -(ert-deftest core-elisp-tests-3-backquote () - (should (eq 3 (eval ``,,'(+ 1 2))))) - -(provide 'core-elisp-tests) -;;; core-elisp-tests.el ends here diff --git a/test/automated/data-tests.el b/test/automated/data-tests.el deleted file mode 100644 index 9abc9e7c68..0000000000 --- a/test/automated/data-tests.el +++ /dev/null @@ -1,257 +0,0 @@ -;;; data-tests.el --- tests for src/data.c - -;; Copyright (C) 2013-2017 Free Software Foundation, Inc. - -;; 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 'cl-lib) -(eval-when-compile (require 'cl)) - -(ert-deftest data-tests-= () - (should-error (=)) - (should (= 1)) - (should (= 2 2)) - (should (= 9 9 9 9 9 9 9 9 9)) - (should-not (apply #'= '(3 8 3))) - (should-error (= 9 9 'foo)) - ;; Short circuits before getting to bad arg - (should-not (= 9 8 'foo))) - -(ert-deftest data-tests-< () - (should-error (<)) - (should (< 1)) - (should (< 2 3)) - (should (< -6 -1 0 2 3 4 8 9 999)) - (should-not (apply #'< '(3 8 3))) - (should-error (< 9 10 'foo)) - ;; Short circuits before getting to bad arg - (should-not (< 9 8 'foo))) - -(ert-deftest data-tests-> () - (should-error (>)) - (should (> 1)) - (should (> 3 2)) - (should (> 6 1 0 -2 -3 -4 -8 -9 -999)) - (should-not (apply #'> '(3 8 3))) - (should-error (> 9 8 'foo)) - ;; Short circuits before getting to bad arg - (should-not (> 8 9 'foo))) - -(ert-deftest data-tests-<= () - (should-error (<=)) - (should (<= 1)) - (should (<= 2 3)) - (should (<= -6 -1 -1 0 0 0 2 3 4 8 999)) - (should-not (apply #'<= '(3 8 3 3))) - (should-error (<= 9 10 'foo)) - ;; Short circuits before getting to bad arg - (should-not (<= 9 8 'foo))) - -(ert-deftest data-tests->= () - (should-error (>=)) - (should (>= 1)) - (should (>= 3 2)) - (should (>= 666 1 0 0 -2 -3 -3 -3 -4 -8 -8 -9 -999)) - (should-not (apply #'>= '(3 8 3))) - (should-error (>= 9 8 'foo)) - ;; Short circuits before getting to bad arg - (should-not (>= 8 9 'foo))) - -;; Bool vector tests. Compactly represent bool vectors as hex -;; strings. - -(ert-deftest bool-vector-count-population-all-0-nil () - (cl-loop for sz in '(0 45 1 64 9 344) - do (let* ((bv (make-bool-vector sz nil))) - (should - (zerop - (bool-vector-count-population bv)))))) - -(ert-deftest bool-vector-count-population-all-1-t () - (cl-loop for sz in '(0 45 1 64 9 344) - do (let* ((bv (make-bool-vector sz t))) - (should - (eql - (bool-vector-count-population bv) - sz))))) - -(ert-deftest bool-vector-count-population-1-nil () - (let* ((bv (make-bool-vector 45 nil))) - (aset bv 40 t) - (aset bv 0 t) - (should - (eql - (bool-vector-count-population bv) - 2)))) - -(ert-deftest bool-vector-count-population-1-t () - (let* ((bv (make-bool-vector 45 t))) - (aset bv 40 nil) - (aset bv 0 nil) - (should - (eql - (bool-vector-count-population bv) - 43)))) - -(defun mock-bool-vector-count-consecutive (a b i) - (loop for i from i below (length a) - while (eq (aref a i) b) - sum 1)) - -(defun test-bool-vector-bv-from-hex-string (desc) - (let (bv nchars nibbles) - (dolist (c (string-to-list desc)) - (push (string-to-number - (char-to-string c) - 16) - nibbles)) - (setf bv (make-bool-vector (* 4 (length nibbles)) nil)) - (let ((i 0)) - (dolist (n (nreverse nibbles)) - (dotimes (_ 4) - (aset bv i (> (logand 1 n) 0)) - (incf i) - (setf n (lsh n -1))))) - bv)) - -(defun test-bool-vector-to-hex-string (bv) - (let (nibbles (v (cl-coerce bv 'list))) - (while v - (push (logior - (lsh (if (nth 0 v) 1 0) 0) - (lsh (if (nth 1 v) 1 0) 1) - (lsh (if (nth 2 v) 1 0) 2) - (lsh (if (nth 3 v) 1 0) 3)) - nibbles) - (setf v (nthcdr 4 v))) - (mapconcat (lambda (n) (format "%X" n)) - (nreverse nibbles) - ""))) - -(defun test-bool-vector-count-consecutive-tc (desc) - "Run a test case for bool-vector-count-consecutive. -DESC is a string describing the test. It is a sequence of -hexadecimal digits describing the bool vector. We exhaustively -test all counts at all possible positions in the vector by -comparing the subr with a much slower lisp implementation." - (let ((bv (test-bool-vector-bv-from-hex-string desc))) - (loop - for lf in '(nil t) - do (loop - for pos from 0 upto (length bv) - for cnt = (mock-bool-vector-count-consecutive bv lf pos) - for rcnt = (bool-vector-count-consecutive bv lf pos) - unless (eql cnt rcnt) - do (error "FAILED testcase %S %3S %3S %3S" - pos lf cnt rcnt))))) - -(defconst bool-vector-test-vectors -'("" - "0" - "F" - "0F" - "F0" - "00000000000000000000000000000FFFFF0000000" - "44a50234053fba3340000023444a50234053fba33400000234" - "12341234123456123412346001234123412345612341234600" - "44a50234053fba33400000234" - "1234123412345612341234600" - "44a50234053fba33400000234" - "1234123412345612341234600" - "44a502340" - "123412341" - "0000000000000000000000000" - "FFFFFFFFFFFFFFFF1")) - -(ert-deftest bool-vector-count-consecutive () - (mapc #'test-bool-vector-count-consecutive-tc - bool-vector-test-vectors)) - -(defun test-bool-vector-apply-mock-op (mock a b c) - "Compute (slowly) the correct result of a bool-vector set operation." - (let (changed nv) - (assert (eql (length b) (length c))) - (if a (setf nv a) - (setf a (make-bool-vector (length b) nil)) - (setf changed t)) - - (loop for i below (length b) - for mockr = (funcall mock - (if (aref b i) 1 0) - (if (aref c i) 1 0)) - for r = (not (= 0 mockr)) - do (progn - (unless (eq (aref a i) r) - (setf changed t)) - (setf (aref a i) r))) - (if changed a))) - -(defun test-bool-vector-binop (mock real) - "Test a binary set operation." - (loop for s1 in bool-vector-test-vectors - for bv1 = (test-bool-vector-bv-from-hex-string s1) - for vecs2 = (cl-remove-if-not - (lambda (x) (eql (length x) (length s1))) - bool-vector-test-vectors) - do (loop for s2 in vecs2 - for bv2 = (test-bool-vector-bv-from-hex-string s2) - for mock-result = (test-bool-vector-apply-mock-op - mock nil bv1 bv2) - for real-result = (funcall real bv1 bv2) - do (progn - (should (equal mock-result real-result)))))) - -(ert-deftest bool-vector-intersection-op () - (test-bool-vector-binop - #'logand - #'bool-vector-intersection)) - -(ert-deftest bool-vector-union-op () - (test-bool-vector-binop - #'logior - #'bool-vector-union)) - -(ert-deftest bool-vector-xor-op () - (test-bool-vector-binop - #'logxor - #'bool-vector-exclusive-or)) - -(ert-deftest bool-vector-set-difference-op () - (test-bool-vector-binop - (lambda (a b) (logand a (lognot b))) - #'bool-vector-set-difference)) - -(ert-deftest bool-vector-change-detection () - (let* ((vc1 (test-bool-vector-bv-from-hex-string "abcdef")) - (vc2 (test-bool-vector-bv-from-hex-string "012345")) - (vc3 (make-bool-vector (length vc1) nil)) - (c1 (bool-vector-union vc1 vc2 vc3)) - (c2 (bool-vector-union vc1 vc2 vc3))) - (should (equal c1 (test-bool-vector-apply-mock-op - #'logior - nil - vc1 vc2))) - (should (not c2)))) - -(ert-deftest bool-vector-not () - (let* ((v1 (test-bool-vector-bv-from-hex-string "FFFF3")) - (v2 (test-bool-vector-bv-from-hex-string "0000C")) - (v3 (bool-vector-not v1))) - (should (equal v2 v3)))) diff --git a/test/automated/help-fns.el b/test/automated/help-fns.el deleted file mode 100644 index 2bcd71b83f..0000000000 --- a/test/automated/help-fns.el +++ /dev/null @@ -1,70 +0,0 @@ -;;; help-fns.el --- tests for help-fns.el - -;; Copyright (C) 2014-2017 Free Software Foundation, Inc. - -;; Maintainer: emacs-devel@gnu.org - -;; 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) - -(autoload 'help-fns-test--macro "help-fns" nil nil t) - -(ert-deftest help-fns-test-bug17410 () - "Test for http://debbugs.gnu.org/17410 ." - (describe-function 'help-fns-test--macro) - (with-current-buffer "*Help*" - (goto-char (point-min)) - (should (search-forward "autoloaded Lisp macro" (line-end-position))))) - -(defun abc\\\[universal-argument\]b\`c\'d\\e\"f (x) - "A function with a funny name. - -\(fn XYZZY)" - x) - -(defun defgh\\\[universal-argument\]b\`c\'d\\e\"f (x) - "Another function with a funny name." - x) - -(ert-deftest help-fns-test-funny-names () - "Test for help with functions with funny names." - (describe-function 'abc\\\[universal-argument\]b\`c\'d\\e\"f) - (with-current-buffer "*Help*" - (goto-char (point-min)) - (should (search-forward - "(abc\\\\\\[universal-argument\\]b\\`c\\'d\\\\e\\\"f XYZZY)"))) - (describe-function 'defgh\\\[universal-argument\]b\`c\'d\\e\"f) - (with-current-buffer "*Help*" - (goto-char (point-min)) - (should (search-forward - "(defgh\\\\\\[universal-argument\\]b\\`c\\'d\\\\e\\\"f X)")))) - -(ert-deftest help-fns-test-describe-symbol () - "Test the `describe-symbol' function." - ;; 'describe-symbol' would originally signal an error for - ;; 'font-lock-comment-face'. - (describe-symbol 'font-lock-comment-face) - (with-current-buffer "*Help*" - (should (> (point-max) 1)) - (goto-char (point-min)) - (should (looking-at "^font-lock-comment-face is ")))) - -;;; help-fns.el ends here diff --git a/test/automated/lexbind-tests.el b/test/automated/lexbind-tests.el deleted file mode 100644 index 483bd1a7cd..0000000000 --- a/test/automated/lexbind-tests.el +++ /dev/null @@ -1,75 +0,0 @@ -;;; lexbind-tests.el --- Testing the lexbind byte-compiler - -;; Copyright (C) 2011-2017 Free Software Foundation, Inc. - -;; Author: Stefan Monnier -;; Keywords: - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Commentary: - -;; - -;;; Code: - -(require 'ert) - -(defconst lexbind-tests - `( - (let ((f #'car)) - (let ((f (lambda (x) (cons (funcall f x) (cdr x))))) - (funcall f '(1 . 2)))) - ) - "List of expression for test. -Each element will be executed by interpreter and with -bytecompiled code, and their results compared.") - - - -(defun lexbind-check-1 (pat) - "Return non-nil if PAT is the same whether directly evalled or compiled." - (let ((warning-minimum-log-level :emergency) - (byte-compile-warnings nil) - (v0 (condition-case nil - (eval pat t) - (error nil))) - (v1 (condition-case nil - (funcall (let ((lexical-binding t)) - (byte-compile `(lambda nil ,pat)))) - (error nil)))) - (equal v0 v1))) - -(put 'lexbind-check-1 'ert-explainer 'lexbind-explain-1) - -(defun lexbind-explain-1 (pat) - (let ((v0 (condition-case nil - (eval pat t) - (error nil))) - (v1 (condition-case nil - (funcall (let ((lexical-binding t)) - (byte-compile (list 'lambda nil pat)))) - (error nil)))) - (format "Expression `%s' gives `%s' if directly evalled, `%s' if compiled." - pat v0 v1))) - -(ert-deftest lexbind-tests () - "Test the Emacs byte compiler lexbind handling." - (dolist (pat lexbind-tests) - (should (lexbind-check-1 pat)))) - - - -(provide 'lexbind-tests) -;;; lexbind-tests.el ends here diff --git a/test/automated/syntax-tests.el b/test/automated/syntax-tests.el deleted file mode 100644 index 7afafdfa76..0000000000 --- a/test/automated/syntax-tests.el +++ /dev/null @@ -1,97 +0,0 @@ -;;; syntax-tests.el --- Testing syntax rules and basic movement -*- lexical-binding: t -*- - -;; Copyright (C) 2014-2017 Free Software Foundation, Inc. - -;; Author: Daniel Colascione -;; Keywords: - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Commentary: - -;; - -;;; Code: -(require 'ert) -(require 'cl-lib) - -(defun run-up-list-test (fn data start instructions) - (cl-labels ((posof (thing) - (and (symbolp thing) - (= (length (symbol-name thing)) 1) - (- (aref (symbol-name thing) 0) ?a -1)))) - (with-temp-buffer - (set-syntax-table (make-syntax-table)) - ;; Use a syntax table in which single quote is a string - ;; character so that we can embed the test data in a lisp string - ;; literal. - (modify-syntax-entry ?\' "\"") - (insert data) - (goto-char (posof start)) - (dolist (instruction instructions) - (cond ((posof instruction) - (funcall fn) - (should (eql (point) (posof instruction)))) - ((symbolp instruction) - (should-error (funcall fn) - :type instruction)) - (t (cl-assert nil nil "unknown ins"))))))) - -(defmacro define-up-list-test (name fn data start &rest expected) - `(ert-deftest ,name () - (run-up-list-test ,fn ,data ',start ',expected))) - -(define-up-list-test up-list-basic - (lambda () (up-list)) - (or "(1 1 (1 1) 1 (1 1) 1)") - ;; abcdefghijklmnopqrstuv - i k v scan-error) - -(define-up-list-test up-list-with-forward-sexp-function - (lambda () - (let ((forward-sexp-function - (lambda (&optional arg) - (let ((forward-sexp-function nil)) - (forward-sexp arg))))) - (up-list))) - (or "(1 1 (1 1) 1 (1 1) 1)") - ;; abcdefghijklmnopqrstuv - i k v scan-error) - -(define-up-list-test up-list-out-of-string - (lambda () (up-list 1 t)) - (or "1 (1 '2 2 (2 2 2' 1) 1") - ;; abcdefghijklmnopqrstuvwxy - o r u scan-error) - -(define-up-list-test up-list-cross-string - (lambda () (up-list 1 t)) - (or "(1 '2 ( 2' 1 '2 ) 2' 1)") - ;; abcdefghijklmnopqrstuvwxy - i r u x scan-error) - -(define-up-list-test up-list-no-cross-string - (lambda () (up-list 1 t t)) - (or "(1 '2 ( 2' 1 '2 ) 2' 1)") - ;; abcdefghijklmnopqrstuvwxy - i k x scan-error) - -(define-up-list-test backward-up-list-basic - (lambda () (backward-up-list)) - (or "(1 1 (1 1) 1 (1 1) 1)") - ;; abcdefghijklmnopqrstuv - i f a scan-error) - -(provide 'syntax-tests) -;;; syntax-tests.el ends here diff --git a/test/automated/tramp-tests.el b/test/automated/tramp-tests.el deleted file mode 100644 index 10e1bde51e..0000000000 --- a/test/automated/tramp-tests.el +++ /dev/null @@ -1,2383 +0,0 @@ -;;; tramp-tests.el --- Tests of remote file access - -;; Copyright (C) 2013-2017 Free Software Foundation, Inc. - -;; Author: Michael Albinus - -;; This program is free software: you can redistribute it and/or -;; modify it under the terms of the GNU General Public License as -;; published by the Free Software Foundation, either version 3 of the -;; License, or (at your option) any later version. -;; -;; This program is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see `http://www.gnu.org/licenses/'. - -;;; Commentary: - -;; The tests require a recent ert.el from Emacs 24.4. - -;; Some of the tests require access to a remote host files. Since -;; this could be problematic, a mock-up connection method "mock" is -;; used. Emulating a remote connection, it simply calls "sh -i". -;; Tramp's file name handlers still run, so this test is sufficient -;; except for connection establishing. - -;; If you want to test a real Tramp connection, set -;; $REMOTE_TEMPORARY_FILE_DIRECTORY to a suitable value in order to -;; overwrite the default value. If you want to skip tests accessing a -;; remote host, set this environment variable to "/dev/null" or -;; whatever is appropriate on your system. - -;; A whole test run can be performed calling the command `tramp-test-all'. - -;;; Code: - -(require 'ert) -(require 'tramp) -(require 'vc) -(require 'vc-bzr) -(require 'vc-git) -(require 'vc-hg) - -(autoload 'dired-uncache "dired") -(declare-function tramp-find-executable "tramp-sh") -(declare-function tramp-get-remote-path "tramp-sh") -(declare-function tramp-get-remote-stat "tramp-sh") -(declare-function tramp-get-remote-perl "tramp-sh") -(defvar tramp-copy-size-limit) -(defvar tramp-persistency-file-name) -(defvar tramp-remote-process-environment) - -;; There is no default value on w32 systems, which could work out of the box. -(defconst tramp-test-temporary-file-directory - (cond - ((getenv "REMOTE_TEMPORARY_FILE_DIRECTORY")) - ((eq system-type 'windows-nt) null-device) - (t (add-to-list - 'tramp-methods - '("mock" - (tramp-login-program "sh") - (tramp-login-args (("-i"))) - (tramp-remote-shell "/bin/sh") - (tramp-remote-shell-args ("-c")) - (tramp-connection-timeout 10))) - (format "/mock::%s" temporary-file-directory))) - "Temporary directory for Tramp tests.") - -(setq password-cache-expiry nil - tramp-verbose 0 - tramp-copy-size-limit nil - tramp-message-show-message nil - tramp-persistency-file-name nil) - -;; This shall happen on hydra only. -(when (getenv "NIX_STORE") - (add-to-list 'tramp-remote-path 'tramp-own-remote-path)) - -(defvar tramp--test-enabled-checked nil - "Cached result of `tramp--test-enabled'. -If the function did run, the value is a cons cell, the `cdr' -being the result.") - -(defun tramp--test-enabled () - "Whether remote file access is enabled." - (unless (consp tramp--test-enabled-checked) - (setq - tramp--test-enabled-checked - (cons - t (ignore-errors - (and - (file-remote-p tramp-test-temporary-file-directory) - (file-directory-p tramp-test-temporary-file-directory) - (file-writable-p tramp-test-temporary-file-directory)))))) - - (when (cdr tramp--test-enabled-checked) - ;; Cleanup connection. - (ignore-errors - (tramp-cleanup-connection - (tramp-dissect-file-name tramp-test-temporary-file-directory) - nil 'keep-password))) - - ;; Return result. - (cdr tramp--test-enabled-checked)) - -(defun tramp--test-make-temp-name (&optional local) - "Create a temporary file name for test." - (expand-file-name - (make-temp-name "tramp-test") - (if local temporary-file-directory tramp-test-temporary-file-directory))) - -(defmacro tramp--instrument-test-case (verbose &rest body) - "Run BODY with `tramp-verbose' equal VERBOSE. -Print the the content of the Tramp debug buffer, if BODY does not -eval properly in `should', `should-not' or `should-error'. BODY -shall not contain a timeout." - (declare (indent 1) (debug (natnump body))) - `(let ((tramp-verbose ,verbose) - (tramp-message-show-message t) - (tramp-debug-on-error t) - (debug-ignored-errors - (cons "^make-symbolic-link not supported$" debug-ignored-errors))) - (unwind-protect - (progn ,@body) - (when (> tramp-verbose 3) - (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil - (with-current-buffer (tramp-get-connection-buffer v) - (message "%s" (buffer-string))) - (with-current-buffer (tramp-get-debug-buffer v) - (message "%s" (buffer-string)))))))) - -(ert-deftest tramp-test00-availability () - "Test availability of Tramp functions." - :expected-result (if (tramp--test-enabled) :passed :failed) - (message "Remote directory: `%s'" tramp-test-temporary-file-directory) - (should (ignore-errors - (and - (file-remote-p tramp-test-temporary-file-directory) - (file-directory-p tramp-test-temporary-file-directory) - (file-writable-p tramp-test-temporary-file-directory))))) - -(ert-deftest tramp-test01-file-name-syntax () - "Check remote file name syntax." - ;; Simple cases. - (should (tramp-tramp-file-p "/method::")) - (should (tramp-tramp-file-p "/host:")) - (should (tramp-tramp-file-p "/user@:")) - (should (tramp-tramp-file-p "/user@host:")) - (should (tramp-tramp-file-p "/method:host:")) - (should (tramp-tramp-file-p "/method:user@:")) - (should (tramp-tramp-file-p "/method:user@host:")) - (should (tramp-tramp-file-p "/method:user@email@host:")) - - ;; Using a port. - (should (tramp-tramp-file-p "/host#1234:")) - (should (tramp-tramp-file-p "/user@host#1234:")) - (should (tramp-tramp-file-p "/method:host#1234:")) - (should (tramp-tramp-file-p "/method:user@host#1234:")) - - ;; Using an IPv4 address. - (should (tramp-tramp-file-p "/1.2.3.4:")) - (should (tramp-tramp-file-p "/user@1.2.3.4:")) - (should (tramp-tramp-file-p "/method:1.2.3.4:")) - (should (tramp-tramp-file-p "/method:user@1.2.3.4:")) - - ;; Using an IPv6 address. - (should (tramp-tramp-file-p "/[]:")) - (should (tramp-tramp-file-p "/[::1]:")) - (should (tramp-tramp-file-p "/user@[::1]:")) - (should (tramp-tramp-file-p "/method:[::1]:")) - (should (tramp-tramp-file-p "/method:user@[::1]:")) - - ;; Local file name part. - (should (tramp-tramp-file-p "/host:/:")) - (should (tramp-tramp-file-p "/method:::")) - (should (tramp-tramp-file-p "/method::/path/to/file")) - (should (tramp-tramp-file-p "/method::file")) - - ;; Multihop. - (should (tramp-tramp-file-p "/method1:|method2::")) - (should (tramp-tramp-file-p "/method1:host1|host2:")) - (should (tramp-tramp-file-p "/method1:host1|method2:host2:")) - (should (tramp-tramp-file-p "/method1:user1@host1|method2:user2@host2:")) - (should (tramp-tramp-file-p - "/method1:user1@host1|method2:user2@host2|method3:user3@host3:")) - - ;; No strings. - (should-not (tramp-tramp-file-p nil)) - (should-not (tramp-tramp-file-p 'symbol)) - ;; "/:" suppresses file name handlers. - (should-not (tramp-tramp-file-p "/::")) - (should-not (tramp-tramp-file-p "/:@:")) - (should-not (tramp-tramp-file-p "/:[]:")) - ;; Multihops require a method. - (should-not (tramp-tramp-file-p "/host1|host2:")) - ;; Methods or hostnames shall be at least two characters on MS Windows. - (when (memq system-type '(cygwin windows-nt)) - (should-not (tramp-tramp-file-p "/c:/path/to/file")) - (should-not (tramp-tramp-file-p "/c::/path/to/file")))) - -(ert-deftest tramp-test02-file-name-dissect () - "Check remote file name components." - (let ((tramp-default-method "default-method") - (tramp-default-user "default-user") - (tramp-default-host "default-host")) - ;; Expand `tramp-default-user' and `tramp-default-host'. - (should (string-equal - (file-remote-p "/method::") - (format "/%s:%s@%s:" "method" "default-user" "default-host"))) - (should (string-equal (file-remote-p "/method::" 'method) "method")) - (should (string-equal (file-remote-p "/method::" 'user) "default-user")) - (should (string-equal (file-remote-p "/method::" 'host) "default-host")) - (should (string-equal (file-remote-p "/method::" 'localname) "")) - (should (string-equal (file-remote-p "/method::" 'hop) nil)) - - ;; Expand `tramp-default-method' and `tramp-default-user'. - (should (string-equal - (file-remote-p "/host:") - (format "/%s:%s@%s:" "default-method" "default-user" "host"))) - (should (string-equal (file-remote-p "/host:" 'method) "default-method")) - (should (string-equal (file-remote-p "/host:" 'user) "default-user")) - (should (string-equal (file-remote-p "/host:" 'host) "host")) - (should (string-equal (file-remote-p "/host:" 'localname) "")) - (should (string-equal (file-remote-p "/host:" 'hop) nil)) - - ;; Expand `tramp-default-method' and `tramp-default-host'. - (should (string-equal - (file-remote-p "/user@:") - (format "/%s:%s@%s:" "default-method""user" "default-host"))) - (should (string-equal (file-remote-p "/user@:" 'method) "default-method")) - (should (string-equal (file-remote-p "/user@:" 'user) "user")) - (should (string-equal (file-remote-p "/user@:" 'host) "default-host")) - (should (string-equal (file-remote-p "/user@:" 'localname) "")) - (should (string-equal (file-remote-p "/user@:" 'hop) nil)) - - ;; Expand `tramp-default-method'. - (should (string-equal - (file-remote-p "/user@host:") - (format "/%s:%s@%s:" "default-method" "user" "host"))) - (should (string-equal - (file-remote-p "/user@host:" 'method) "default-method")) - (should (string-equal (file-remote-p "/user@host:" 'user) "user")) - (should (string-equal (file-remote-p "/user@host:" 'host) "host")) - (should (string-equal (file-remote-p "/user@host:" 'localname) "")) - (should (string-equal (file-remote-p "/user@host:" 'hop) nil)) - - ;; Expand `tramp-default-user'. - (should (string-equal - (file-remote-p "/method:host:") - (format "/%s:%s@%s:" "method" "default-user" "host"))) - (should (string-equal (file-remote-p "/method:host:" 'method) "method")) - (should (string-equal (file-remote-p "/method:host:" 'user) "default-user")) - (should (string-equal (file-remote-p "/method:host:" 'host) "host")) - (should (string-equal (file-remote-p "/method:host:" 'localname) "")) - (should (string-equal (file-remote-p "/method:host:" 'hop) nil)) - - ;; Expand `tramp-default-host'. - (should (string-equal - (file-remote-p "/method:user@:") - (format "/%s:%s@%s:" "method" "user" "default-host"))) - (should (string-equal (file-remote-p "/method:user@:" 'method) "method")) - (should (string-equal (file-remote-p "/method:user@:" 'user) "user")) - (should (string-equal (file-remote-p "/method:user@:" 'host) - "default-host")) - (should (string-equal (file-remote-p "/method:user@:" 'localname) "")) - (should (string-equal (file-remote-p "/method:user@:" 'hop) nil)) - - ;; No expansion. - (should (string-equal - (file-remote-p "/method:user@host:") - (format "/%s:%s@%s:" "method" "user" "host"))) - (should (string-equal - (file-remote-p "/method:user@host:" 'method) "method")) - (should (string-equal (file-remote-p "/method:user@host:" 'user) "user")) - (should (string-equal (file-remote-p "/method:user@host:" 'host) "host")) - (should (string-equal (file-remote-p "/method:user@host:" 'localname) "")) - (should (string-equal (file-remote-p "/method:user@host:" 'hop) nil)) - - ;; No expansion. - (should (string-equal - (file-remote-p "/method:user@email@host:") - (format "/%s:%s@%s:" "method" "user@email" "host"))) - (should (string-equal - (file-remote-p "/method:user@email@host:" 'method) "method")) - (should (string-equal - (file-remote-p "/method:user@email@host:" 'user) "user@email")) - (should (string-equal - (file-remote-p "/method:user@email@host:" 'host) "host")) - (should (string-equal - (file-remote-p "/method:user@email@host:" 'localname) "")) - (should (string-equal - (file-remote-p "/method:user@email@host:" 'hop) nil)) - - ;; Expand `tramp-default-method' and `tramp-default-user'. - (should (string-equal - (file-remote-p "/host#1234:") - (format "/%s:%s@%s:" "default-method" "default-user" "host#1234"))) - (should (string-equal - (file-remote-p "/host#1234:" 'method) "default-method")) - (should (string-equal (file-remote-p "/host#1234:" 'user) "default-user")) - (should (string-equal (file-remote-p "/host#1234:" 'host) "host#1234")) - (should (string-equal (file-remote-p "/host#1234:" 'localname) "")) - (should (string-equal (file-remote-p "/host#1234:" 'hop) nil)) - - ;; Expand `tramp-default-method'. - (should (string-equal - (file-remote-p "/user@host#1234:") - (format "/%s:%s@%s:" "default-method" "user" "host#1234"))) - (should (string-equal - (file-remote-p "/user@host#1234:" 'method) "default-method")) - (should (string-equal (file-remote-p "/user@host#1234:" 'user) "user")) - (should (string-equal (file-remote-p "/user@host#1234:" 'host) "host#1234")) - (should (string-equal (file-remote-p "/user@host#1234:" 'localname) "")) - (should (string-equal (file-remote-p "/user@host#1234:" 'hop) nil)) - - ;; Expand `tramp-default-user'. - (should (string-equal - (file-remote-p "/method:host#1234:") - (format "/%s:%s@%s:" "method" "default-user" "host#1234"))) - (should (string-equal - (file-remote-p "/method:host#1234:" 'method) "method")) - (should (string-equal - (file-remote-p "/method:host#1234:" 'user) "default-user")) - (should (string-equal - (file-remote-p "/method:host#1234:" 'host) "host#1234")) - (should (string-equal (file-remote-p "/method:host#1234:" 'localname) "")) - (should (string-equal (file-remote-p "/method:host#1234:" 'hop) nil)) - - ;; No expansion. - (should (string-equal - (file-remote-p "/method:user@host#1234:") - (format "/%s:%s@%s:" "method" "user" "host#1234"))) - (should (string-equal - (file-remote-p "/method:user@host#1234:" 'method) "method")) - (should (string-equal - (file-remote-p "/method:user@host#1234:" 'user) "user")) - (should (string-equal - (file-remote-p "/method:user@host#1234:" 'host) "host#1234")) - (should (string-equal - (file-remote-p "/method:user@host#1234:" 'localname) "")) - (should (string-equal - (file-remote-p "/method:user@host#1234:" 'hop) nil)) - - ;; Expand `tramp-default-method' and `tramp-default-user'. - (should (string-equal - (file-remote-p "/1.2.3.4:") - (format "/%s:%s@%s:" "default-method" "default-user" "1.2.3.4"))) - (should (string-equal (file-remote-p "/1.2.3.4:" 'method) "default-method")) - (should (string-equal (file-remote-p "/1.2.3.4:" 'user) "default-user")) - (should (string-equal (file-remote-p "/1.2.3.4:" 'host) "1.2.3.4")) - (should (string-equal (file-remote-p "/1.2.3.4:" 'localname) "")) - (should (string-equal (file-remote-p "/1.2.3.4:" 'hop) nil)) - - ;; Expand `tramp-default-method'. - (should (string-equal - (file-remote-p "/user@1.2.3.4:") - (format "/%s:%s@%s:" "default-method" "user" "1.2.3.4"))) - (should (string-equal - (file-remote-p "/user@1.2.3.4:" 'method) "default-method")) - (should (string-equal (file-remote-p "/user@1.2.3.4:" 'user) "user")) - (should (string-equal (file-remote-p "/user@1.2.3.4:" 'host) "1.2.3.4")) - (should (string-equal (file-remote-p "/user@1.2.3.4:" 'localname) "")) - (should (string-equal (file-remote-p "/user@1.2.3.4:" 'hop) nil)) - - ;; Expand `tramp-default-user'. - (should (string-equal - (file-remote-p "/method:1.2.3.4:") - (format "/%s:%s@%s:" "method" "default-user" "1.2.3.4"))) - (should (string-equal (file-remote-p "/method:1.2.3.4:" 'method) "method")) - (should (string-equal - (file-remote-p "/method:1.2.3.4:" 'user) "default-user")) - (should (string-equal (file-remote-p "/method:1.2.3.4:" 'host) "1.2.3.4")) - (should (string-equal (file-remote-p "/method:1.2.3.4:" 'localname) "")) - (should (string-equal (file-remote-p "/method:1.2.3.4:" 'hop) nil)) - - ;; No expansion. - (should (string-equal - (file-remote-p "/method:user@1.2.3.4:") - (format "/%s:%s@%s:" "method" "user" "1.2.3.4"))) - (should (string-equal - (file-remote-p "/method:user@1.2.3.4:" 'method) "method")) - (should (string-equal (file-remote-p "/method:user@1.2.3.4:" 'user) "user")) - (should (string-equal - (file-remote-p "/method:user@1.2.3.4:" 'host) "1.2.3.4")) - (should (string-equal - (file-remote-p "/method:user@1.2.3.4:" 'localname) "")) - (should (string-equal - (file-remote-p "/method:user@1.2.3.4:" 'hop) nil)) - - ;; Expand `tramp-default-method', `tramp-default-user' and - ;; `tramp-default-host'. - (should (string-equal - (file-remote-p "/[]:") - (format - "/%s:%s@%s:" "default-method" "default-user" "default-host"))) - (should (string-equal (file-remote-p "/[]:" 'method) "default-method")) - (should (string-equal (file-remote-p "/[]:" 'user) "default-user")) - (should (string-equal (file-remote-p "/[]:" 'host) "default-host")) - (should (string-equal (file-remote-p "/[]:" 'localname) "")) - (should (string-equal (file-remote-p "/[]:" 'hop) nil)) - - ;; Expand `tramp-default-method' and `tramp-default-user'. - (let ((tramp-default-host "::1")) - (should (string-equal - (file-remote-p "/[]:") - (format "/%s:%s@%s:" "default-method" "default-user" "[::1]"))) - (should (string-equal (file-remote-p "/[]:" 'method) "default-method")) - (should (string-equal (file-remote-p "/[]:" 'user) "default-user")) - (should (string-equal (file-remote-p "/[]:" 'host) "::1")) - (should (string-equal (file-remote-p "/[]:" 'localname) "")) - (should (string-equal (file-remote-p "/[]:" 'hop) nil))) - - ;; Expand `tramp-default-method' and `tramp-default-user'. - (should (string-equal - (file-remote-p "/[::1]:") - (format "/%s:%s@%s:" "default-method" "default-user" "[::1]"))) - (should (string-equal (file-remote-p "/[::1]:" 'method) "default-method")) - (should (string-equal (file-remote-p "/[::1]:" 'user) "default-user")) - (should (string-equal (file-remote-p "/[::1]:" 'host) "::1")) - (should (string-equal (file-remote-p "/[::1]:" 'localname) "")) - (should (string-equal (file-remote-p "/[::1]:" 'hop) nil)) - - ;; Expand `tramp-default-method'. - (should (string-equal - (file-remote-p "/user@[::1]:") - (format "/%s:%s@%s:" "default-method" "user" "[::1]"))) - (should (string-equal - (file-remote-p "/user@[::1]:" 'method) "default-method")) - (should (string-equal (file-remote-p "/user@[::1]:" 'user) "user")) - (should (string-equal (file-remote-p "/user@[::1]:" 'host) "::1")) - (should (string-equal (file-remote-p "/user@[::1]:" 'localname) "")) - (should (string-equal (file-remote-p "/user@[::1]:" 'hop) nil)) - - ;; Expand `tramp-default-user'. - (should (string-equal - (file-remote-p "/method:[::1]:") - (format "/%s:%s@%s:" "method" "default-user" "[::1]"))) - (should (string-equal (file-remote-p "/method:[::1]:" 'method) "method")) - (should (string-equal - (file-remote-p "/method:[::1]:" 'user) "default-user")) - (should (string-equal (file-remote-p "/method:[::1]:" 'host) "::1")) - (should (string-equal (file-remote-p "/method:[::1]:" 'localname) "")) - (should (string-equal (file-remote-p "/method:[::1]:" 'hop) nil)) - - ;; No expansion. - (should (string-equal - (file-remote-p "/method:user@[::1]:") - (format "/%s:%s@%s:" "method" "user" "[::1]"))) - (should (string-equal - (file-remote-p "/method:user@[::1]:" 'method) "method")) - (should (string-equal (file-remote-p "/method:user@[::1]:" 'user) "user")) - (should (string-equal (file-remote-p "/method:user@[::1]:" 'host) "::1")) - (should (string-equal - (file-remote-p "/method:user@[::1]:" 'localname) "")) - (should (string-equal (file-remote-p "/method:user@[::1]:" 'hop) nil)) - - ;; Local file name part. - (should (string-equal (file-remote-p "/host:/:" 'localname) "/:")) - (should (string-equal (file-remote-p "/method:::" 'localname) ":")) - (should (string-equal (file-remote-p "/method:: " 'localname) " ")) - (should (string-equal (file-remote-p "/method::file" 'localname) "file")) - (should (string-equal - (file-remote-p "/method::/path/to/file" 'localname) - "/path/to/file")) - - ;; Multihop. - (should - (string-equal - (file-remote-p "/method1:user1@host1|method2:user2@host2:/path/to/file") - (format "/%s:%s@%s|%s:%s@%s:" - "method1" "user1" "host1" "method2" "user2" "host2"))) - (should - (string-equal - (file-remote-p - "/method1:user1@host1|method2:user2@host2:/path/to/file" 'method) - "method2")) - (should - (string-equal - (file-remote-p - "/method1:user1@host1|method2:user2@host2:/path/to/file" 'user) - "user2")) - (should - (string-equal - (file-remote-p - "/method1:user1@host1|method2:user2@host2:/path/to/file" 'host) - "host2")) - (should - (string-equal - (file-remote-p - "/method1:user1@host1|method2:user2@host2:/path/to/file" 'localname) - "/path/to/file")) - (should - (string-equal - (file-remote-p - "/method1:user1@host1|method2:user2@host2:/path/to/file" 'hop) - (format "%s:%s@%s|" - "method1" "user1" "host1"))) - - (should - (string-equal - (file-remote-p - "/method1:user1@host1|method2:user2@host2|method3:user3@host3:/path/to/file") - (format "/%s:%s@%s|%s:%s@%s|%s:%s@%s:" - "method1" "user1" "host1" - "method2" "user2" "host2" - "method3" "user3" "host3"))) - (should - (string-equal - (file-remote-p - "/method1:user1@host1|method2:user2@host2|method3:user3@host3:/path/to/file" - 'method) - "method3")) - (should - (string-equal - (file-remote-p - "/method1:user1@host1|method2:user2@host2|method3:user3@host3:/path/to/file" - 'user) - "user3")) - (should - (string-equal - (file-remote-p - "/method1:user1@host1|method2:user2@host2|method3:user3@host3:/path/to/file" - 'host) - "host3")) - (should - (string-equal - (file-remote-p - "/method1:user1@host1|method2:user2@host2|method3:user3@host3:/path/to/file" - 'localname) - "/path/to/file")) - (should - (string-equal - (file-remote-p - "/method1:user1@host1|method2:user2@host2|method3:user3@host3:/path/to/file" - 'hop) - (format "%s:%s@%s|%s:%s@%s|" - "method1" "user1" "host1" "method2" "user2" "host2"))))) - -(ert-deftest tramp-test03-file-name-defaults () - "Check default values for some methods." - ;; Default values in tramp-adb.el. - (should (string-equal (file-remote-p "/adb::" 'host) "")) - ;; Default values in tramp-ftp.el. - (should (string-equal (file-remote-p "/ftp.host:" 'method) "ftp")) - (dolist (u '("ftp" "anonymous")) - (should (string-equal (file-remote-p (format "/%s@:" u) 'method) "ftp"))) - ;; Default values in tramp-gvfs.el. - (when (and (load "tramp-gvfs" 'noerror 'nomessage) - (symbol-value 'tramp-gvfs-enabled)) - (should (string-equal (file-remote-p "/synce::" 'user) nil))) - ;; Default values in tramp-gw.el. - (dolist (m '("tunnel" "socks")) - (should - (string-equal (file-remote-p (format "/%s::" m) 'user) (user-login-name)))) - ;; Default values in tramp-sh.el. - (dolist (h `("127.0.0.1" "[::1]" "localhost" "localhost6" ,(system-name))) - (should (string-equal (file-remote-p (format "/root@%s:" h) 'method) "su"))) - (dolist (m '("su" "sudo" "ksu")) - (should (string-equal (file-remote-p (format "/%s::" m) 'user) "root"))) - (dolist (m '("rcp" "remcp" "rsh" "telnet" "krlogin" "fcp")) - (should - (string-equal (file-remote-p (format "/%s::" m) 'user) (user-login-name)))) - ;; Default values in tramp-smb.el. - (should (string-equal (file-remote-p "/user%domain@host:" 'method) "smb")) - (should (string-equal (file-remote-p "/smb::" 'user) nil))) - -(ert-deftest tramp-test04-substitute-in-file-name () - "Check `substitute-in-file-name'." - (should (string-equal (substitute-in-file-name "/method:host://foo") "/foo")) - (should - (string-equal - (substitute-in-file-name "/method:host:/path//foo") "/method:host:/foo")) - (should - (string-equal (substitute-in-file-name "/method:host:/path///foo") "/foo")) - (should - (string-equal - (substitute-in-file-name "/method:host:/path/~/foo") "/method:host:~/foo")) - (should - (string-equal (substitute-in-file-name "/method:host:/path//~/foo") "~/foo")) - (let (process-environment) - (should - (string-equal - (substitute-in-file-name "/method:host:/path/$FOO") - "/method:host:/path/$FOO")) - (setenv "FOO" "bla") - (should - (string-equal - (substitute-in-file-name "/method:host:/path/$FOO") - "/method:host:/path/bla")) - (should - (string-equal - (substitute-in-file-name "/method:host:/path/$$FOO") - "/method:host:/path/$FOO")))) - -(ert-deftest tramp-test05-expand-file-name () - "Check `expand-file-name'." - (should - (string-equal - (expand-file-name "/method:host:/path/./file") "/method:host:/path/file")) - (should - (string-equal - (expand-file-name "/method:host:/path/../file") "/method:host:/file"))) - -(ert-deftest tramp-test06-directory-file-name () - "Check `directory-file-name'. -This checks also `file-name-as-directory', `file-name-directory', -`file-name-nondirectory' and `unhandled-file-name-directory'." - (should - (string-equal - (directory-file-name "/method:host:/path/to/file") - "/method:host:/path/to/file")) - (should - (string-equal - (directory-file-name "/method:host:/path/to/file/") - "/method:host:/path/to/file")) - (should - (string-equal - (file-name-as-directory "/method:host:/path/to/file") - "/method:host:/path/to/file/")) - (should - (string-equal - (file-name-as-directory "/method:host:/path/to/file/") - "/method:host:/path/to/file/")) - (should - (string-equal - (file-name-directory "/method:host:/path/to/file") - "/method:host:/path/to/")) - (should - (string-equal - (file-name-directory "/method:host:/path/to/file/") - "/method:host:/path/to/file/")) - (should - (string-equal (file-name-nondirectory "/method:host:/path/to/file") "file")) - (should - (string-equal (file-name-nondirectory "/method:host:/path/to/file/") "")) - (should-not - (unhandled-file-name-directory "/method:host:/path/to/file"))) - -(ert-deftest tramp-test07-file-exists-p () - "Check `file-exist-p', `write-region' and `delete-file'." - (skip-unless (tramp--test-enabled)) - - (let ((tmp-name (tramp--test-make-temp-name))) - (should-not (file-exists-p tmp-name)) - (write-region "foo" nil tmp-name) - (should (file-exists-p tmp-name)) - (delete-file tmp-name) - (should-not (file-exists-p tmp-name)))) - -(ert-deftest tramp-test08-file-local-copy () - "Check `file-local-copy'." - (skip-unless (tramp--test-enabled)) - - (let ((tmp-name1 (tramp--test-make-temp-name)) - tmp-name2) - (unwind-protect - (progn - (write-region "foo" nil tmp-name1) - (should (setq tmp-name2 (file-local-copy tmp-name1))) - (with-temp-buffer - (insert-file-contents tmp-name2) - (should (string-equal (buffer-string) "foo"))) - ;; Check also that a file transfer with compression works. - (let ((default-directory tramp-test-temporary-file-directory) - (tramp-copy-size-limit 4) - (tramp-inline-compress-start-size 2)) - (delete-file tmp-name2) - (should (setq tmp-name2 (file-local-copy tmp-name1))))) - - ;; Cleanup. - (ignore-errors - (delete-file tmp-name1) - (delete-file tmp-name2))))) - -(ert-deftest tramp-test09-insert-file-contents () - "Check `insert-file-contents'." - (skip-unless (tramp--test-enabled)) - - (let ((tmp-name (tramp--test-make-temp-name))) - (unwind-protect - (progn - (write-region "foo" nil tmp-name) - (with-temp-buffer - (insert-file-contents tmp-name) - (should (string-equal (buffer-string) "foo")) - (insert-file-contents tmp-name) - (should (string-equal (buffer-string) "foofoo")) - ;; Insert partly. - (insert-file-contents tmp-name nil 1 3) - (should (string-equal (buffer-string) "oofoofoo")) - ;; Replace. - (insert-file-contents tmp-name nil nil nil 'replace) - (should (string-equal (buffer-string) "foo")))) - - ;; Cleanup. - (ignore-errors (delete-file tmp-name))))) - -(ert-deftest tramp-test10-write-region () - "Check `write-region'." - (skip-unless (tramp--test-enabled)) - - (let ((tmp-name (tramp--test-make-temp-name))) - (unwind-protect - (progn - (with-temp-buffer - (insert "foo") - (write-region nil nil tmp-name)) - (with-temp-buffer - (insert-file-contents tmp-name) - (should (string-equal (buffer-string) "foo"))) - ;; Append. - (with-temp-buffer - (insert "bla") - (write-region nil nil tmp-name 'append)) - (with-temp-buffer - (insert-file-contents tmp-name) - (should (string-equal (buffer-string) "foobla"))) - ;; Write string. - (write-region "foo" nil tmp-name) - (with-temp-buffer - (insert-file-contents tmp-name) - (should (string-equal (buffer-string) "foo"))) - ;; Write partly. - (with-temp-buffer - (insert "123456789") - (write-region 3 5 tmp-name)) - (with-temp-buffer - (insert-file-contents tmp-name) - (should (string-equal (buffer-string) "34")))) - - ;; Cleanup. - (ignore-errors (delete-file tmp-name))))) - -(ert-deftest tramp-test11-copy-file () - "Check `copy-file'." - (skip-unless (tramp--test-enabled)) - - (let ((tmp-name1 (tramp--test-make-temp-name)) - (tmp-name2 (tramp--test-make-temp-name)) - (tmp-name3 (tramp--test-make-temp-name)) - (tmp-name4 (tramp--test-make-temp-name 'local)) - (tmp-name5 (tramp--test-make-temp-name 'local))) - - ;; Copy on remote side. - (unwind-protect - (progn - (write-region "foo" nil tmp-name1) - (copy-file tmp-name1 tmp-name2) - (should (file-exists-p tmp-name2)) - (with-temp-buffer - (insert-file-contents tmp-name2) - (should (string-equal (buffer-string) "foo"))) - (should-error (copy-file tmp-name1 tmp-name2)) - (copy-file tmp-name1 tmp-name2 'ok) - (make-directory tmp-name3) - (copy-file tmp-name1 tmp-name3) - (should - (file-exists-p - (expand-file-name (file-name-nondirectory tmp-name1) tmp-name3)))) - - ;; Cleanup. - (ignore-errors (delete-file tmp-name1)) - (ignore-errors (delete-file tmp-name2)) - (ignore-errors (delete-directory tmp-name3 'recursive))) - - ;; Copy from remote side to local side. - (unwind-protect - (progn - (write-region "foo" nil tmp-name1) - (copy-file tmp-name1 tmp-name4) - (should (file-exists-p tmp-name4)) - (with-temp-buffer - (insert-file-contents tmp-name4) - (should (string-equal (buffer-string) "foo"))) - (should-error (copy-file tmp-name1 tmp-name4)) - (copy-file tmp-name1 tmp-name4 'ok) - (make-directory tmp-name5) - (copy-file tmp-name1 tmp-name5) - (should - (file-exists-p - (expand-file-name (file-name-nondirectory tmp-name1) tmp-name5)))) - - ;; Cleanup. - (ignore-errors (delete-file tmp-name1)) - (ignore-errors (delete-file tmp-name4)) - (ignore-errors (delete-directory tmp-name5 'recursive))) - - ;; Copy from local side to remote side. - (unwind-protect - (progn - (write-region "foo" nil tmp-name4 nil 'nomessage) - (copy-file tmp-name4 tmp-name1) - (should (file-exists-p tmp-name1)) - (with-temp-buffer - (insert-file-contents tmp-name1) - (should (string-equal (buffer-string) "foo"))) - (should-error (copy-file tmp-name4 tmp-name1)) - (copy-file tmp-name4 tmp-name1 'ok) - (make-directory tmp-name3) - (copy-file tmp-name4 tmp-name3) - (should - (file-exists-p - (expand-file-name (file-name-nondirectory tmp-name4) tmp-name3)))) - - ;; Cleanup. - (ignore-errors (delete-file tmp-name1)) - (ignore-errors (delete-file tmp-name4)) - (ignore-errors (delete-directory tmp-name3 'recursive))))) - -(ert-deftest tramp-test12-rename-file () - "Check `rename-file'." - (skip-unless (tramp--test-enabled)) - - (let ((tmp-name1 (tramp--test-make-temp-name)) - (tmp-name2 (tramp--test-make-temp-name)) - (tmp-name3 (tramp--test-make-temp-name)) - (tmp-name4 (tramp--test-make-temp-name 'local)) - (tmp-name5 (tramp--test-make-temp-name 'local))) - - ;; Rename on remote side. - (unwind-protect - (progn - (write-region "foo" nil tmp-name1) - (rename-file tmp-name1 tmp-name2) - (should-not (file-exists-p tmp-name1)) - (should (file-exists-p tmp-name2)) - (with-temp-buffer - (insert-file-contents tmp-name2) - (should (string-equal (buffer-string) "foo"))) - (write-region "foo" nil tmp-name1) - (should-error (rename-file tmp-name1 tmp-name2)) - (rename-file tmp-name1 tmp-name2 'ok) - (should-not (file-exists-p tmp-name1)) - (write-region "foo" nil tmp-name1) - (make-directory tmp-name3) - (rename-file tmp-name1 tmp-name3) - (should-not (file-exists-p tmp-name1)) - (should - (file-exists-p - (expand-file-name (file-name-nondirectory tmp-name1) tmp-name3)))) - - ;; Cleanup. - (ignore-errors (delete-file tmp-name1)) - (ignore-errors (delete-file tmp-name2)) - (ignore-errors (delete-directory tmp-name3 'recursive))) - - ;; Rename from remote side to local side. - (unwind-protect - (progn - (write-region "foo" nil tmp-name1) - (rename-file tmp-name1 tmp-name4) - (should-not (file-exists-p tmp-name1)) - (should (file-exists-p tmp-name4)) - (with-temp-buffer - (insert-file-contents tmp-name4) - (should (string-equal (buffer-string) "foo"))) - (write-region "foo" nil tmp-name1) - (should-error (rename-file tmp-name1 tmp-name4)) - (rename-file tmp-name1 tmp-name4 'ok) - (should-not (file-exists-p tmp-name1)) - (write-region "foo" nil tmp-name1) - (make-directory tmp-name5) - (rename-file tmp-name1 tmp-name5) - (should-not (file-exists-p tmp-name1)) - (should - (file-exists-p - (expand-file-name (file-name-nondirectory tmp-name1) tmp-name5)))) - - ;; Cleanup. - (ignore-errors (delete-file tmp-name1)) - (ignore-errors (delete-file tmp-name4)) - (ignore-errors (delete-directory tmp-name5 'recursive))) - - ;; Rename from local side to remote side. - (unwind-protect - (progn - (write-region "foo" nil tmp-name4 nil 'nomessage) - (rename-file tmp-name4 tmp-name1) - (should-not (file-exists-p tmp-name4)) - (should (file-exists-p tmp-name1)) - (with-temp-buffer - (insert-file-contents tmp-name1) - (should (string-equal (buffer-string) "foo"))) - (write-region "foo" nil tmp-name4 nil 'nomessage) - (should-error (rename-file tmp-name4 tmp-name1)) - (rename-file tmp-name4 tmp-name1 'ok) - (should-not (file-exists-p tmp-name4)) - (write-region "foo" nil tmp-name4 nil 'nomessage) - (make-directory tmp-name3) - (rename-file tmp-name4 tmp-name3) - (should-not (file-exists-p tmp-name4)) - (should - (file-exists-p - (expand-file-name (file-name-nondirectory tmp-name4) tmp-name3)))) - - ;; Cleanup. - (ignore-errors (delete-file tmp-name1)) - (ignore-errors (delete-file tmp-name4)) - (ignore-errors (delete-directory tmp-name3 'recursive))))) - -(ert-deftest tramp-test13-make-directory () - "Check `make-directory'. -This tests also `file-directory-p' and `file-accessible-directory-p'." - (skip-unless (tramp--test-enabled)) - - (let* ((tmp-name1 (tramp--test-make-temp-name)) - (tmp-name2 (expand-file-name "foo/bar" tmp-name1))) - (unwind-protect - (progn - (make-directory tmp-name1) - (should (file-directory-p tmp-name1)) - (should (file-accessible-directory-p tmp-name1)) - (should-error (make-directory tmp-name2) :type 'file-error) - (make-directory tmp-name2 'parents) - (should (file-directory-p tmp-name2)) - (should (file-accessible-directory-p tmp-name2))) - - ;; Cleanup. - (ignore-errors (delete-directory tmp-name1 'recursive))))) - -(ert-deftest tramp-test14-delete-directory () - "Check `delete-directory'." - (skip-unless (tramp--test-enabled)) - - (let ((tmp-name (tramp--test-make-temp-name))) - ;; Delete empty directory. - (make-directory tmp-name) - (should (file-directory-p tmp-name)) - (delete-directory tmp-name) - (should-not (file-directory-p tmp-name)) - ;; Delete non-empty directory. - (make-directory tmp-name) - (write-region "foo" nil (expand-file-name "bla" tmp-name)) - (should-error (delete-directory tmp-name) :type 'file-error) - (delete-directory tmp-name 'recursive) - (should-not (file-directory-p tmp-name)))) - -(ert-deftest tramp-test15-copy-directory () - "Check `copy-directory'." - (skip-unless (tramp--test-enabled)) - (skip-unless - (not - (eq - (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory) - 'tramp-smb-file-name-handler))) - - (let* ((tmp-name1 (tramp--test-make-temp-name)) - (tmp-name2 (tramp--test-make-temp-name)) - (tmp-name3 (expand-file-name - (file-name-nondirectory tmp-name1) tmp-name2)) - (tmp-name4 (expand-file-name "foo" tmp-name1)) - (tmp-name5 (expand-file-name "foo" tmp-name2)) - (tmp-name6 (expand-file-name "foo" tmp-name3))) - (unwind-protect - (progn - ;; Copy empty directory. - (make-directory tmp-name1) - (write-region "foo" nil tmp-name4) - (should (file-directory-p tmp-name1)) - (should (file-exists-p tmp-name4)) - (copy-directory tmp-name1 tmp-name2) - (should (file-directory-p tmp-name2)) - (should (file-exists-p tmp-name5)) - ;; Target directory does exist already. - (copy-directory tmp-name1 tmp-name2) - (should (file-directory-p tmp-name3)) - (should (file-exists-p tmp-name6))) - - ;; Cleanup. - (ignore-errors - (delete-directory tmp-name1 'recursive) - (delete-directory tmp-name2 'recursive))))) - -(ert-deftest tramp-test16-directory-files () - "Check `directory-files'." - (skip-unless (tramp--test-enabled)) - - (let* ((tmp-name1 (tramp--test-make-temp-name)) - (tmp-name2 (expand-file-name "bla" tmp-name1)) - (tmp-name3 (expand-file-name "foo" tmp-name1))) - (unwind-protect - (progn - (make-directory tmp-name1) - (write-region "foo" nil tmp-name2) - (write-region "bla" nil tmp-name3) - (should (file-directory-p tmp-name1)) - (should (file-exists-p tmp-name2)) - (should (file-exists-p tmp-name3)) - (should (equal (directory-files tmp-name1) '("." ".." "bla" "foo"))) - (should (equal (directory-files tmp-name1 'full) - `(,(concat tmp-name1 "/.") - ,(concat tmp-name1 "/..") - ,tmp-name2 ,tmp-name3))) - (should (equal (directory-files - tmp-name1 nil directory-files-no-dot-files-regexp) - '("bla" "foo"))) - (should (equal (directory-files - tmp-name1 'full directory-files-no-dot-files-regexp) - `(,tmp-name2 ,tmp-name3)))) - - ;; Cleanup. - (ignore-errors (delete-directory tmp-name1 'recursive))))) - -(ert-deftest tramp-test17-insert-directory () - "Check `insert-directory'." - (skip-unless (tramp--test-enabled)) - - (let* ((tmp-name1 (tramp--test-make-temp-name)) - (tmp-name2 (expand-file-name "foo" tmp-name1)) - ;; We test for the summary line. Keyword "total" could be localized. - (process-environment - (append '("LANG=C" "LANGUAGE=C" "LC_ALL=C") process-environment))) - (unwind-protect - (progn - (make-directory tmp-name1) - (write-region "foo" nil tmp-name2) - (should (file-directory-p tmp-name1)) - (should (file-exists-p tmp-name2)) - (with-temp-buffer - (insert-directory tmp-name1 nil) - (goto-char (point-min)) - (should (looking-at-p (regexp-quote tmp-name1)))) - (with-temp-buffer - (insert-directory tmp-name1 "-al") - (goto-char (point-min)) - (should (looking-at-p (format "^.+ %s$" (regexp-quote tmp-name1))))) - (with-temp-buffer - (insert-directory (file-name-as-directory tmp-name1) "-al") - (goto-char (point-min)) - (should - (looking-at-p (format "^.+ %s/$" (regexp-quote tmp-name1))))) - (with-temp-buffer - (insert-directory - (file-name-as-directory tmp-name1) "-al" nil 'full-directory-p) - (goto-char (point-min)) - (should - (looking-at-p - (concat - ;; There might be a summary line. - "\\(total.+[[:digit:]]+\n\\)?" - ;; We don't know in which order ".", ".." and "foo" appear. - "\\(.+ \\(\\.?\\.\\|foo\\)\n\\)\\{3\\}"))))) - - ;; Cleanup. - (ignore-errors (delete-directory tmp-name1 'recursive))))) - -(ert-deftest tramp-test18-file-attributes () - "Check `file-attributes'. -This tests also `file-readable-p' and `file-regular-p'." - (skip-unless (tramp--test-enabled)) - - ;; We must use `file-truename' for the temporary directory, because - ;; it could be located on a symlinked directory. This would let the - ;; test fail. - (let* ((tramp-test-temporary-file-directory - (file-truename tramp-test-temporary-file-directory)) - (tmp-name1 (tramp--test-make-temp-name)) - (tmp-name2 (tramp--test-make-temp-name)) - ;; File name with "//". - (tmp-name3 - (format - "%s%s" - (file-remote-p tmp-name1) - (replace-regexp-in-string - "/" "//" (file-remote-p tmp-name1 'localname)))) - attr) - (unwind-protect - (progn - (write-region "foo" nil tmp-name1) - (should (file-exists-p tmp-name1)) - (setq attr (file-attributes tmp-name1)) - (should (consp attr)) - (should (file-exists-p tmp-name1)) - (should (file-readable-p tmp-name1)) - (should (file-regular-p tmp-name1)) - ;; We do not test inodes and device numbers. - (should (null (car attr))) - (should (numberp (nth 1 attr))) ;; Link. - (should (numberp (nth 2 attr))) ;; Uid. - (should (numberp (nth 3 attr))) ;; Gid. - ;; Last access time. - (should (stringp (current-time-string (nth 4 attr)))) - ;; Last modification time. - (should (stringp (current-time-string (nth 5 attr)))) - ;; Last status change time. - (should (stringp (current-time-string (nth 6 attr)))) - (should (numberp (nth 7 attr))) ;; Size. - (should (stringp (nth 8 attr))) ;; Modes. - - (setq attr (file-attributes tmp-name1 'string)) - (should (stringp (nth 2 attr))) ;; Uid. - (should (stringp (nth 3 attr))) ;; Gid. - - (condition-case err - (progn - (make-symbolic-link tmp-name1 tmp-name2) - (should (file-exists-p tmp-name2)) - (should (file-symlink-p tmp-name2)) - (setq attr (file-attributes tmp-name2)) - (should (string-equal - (car attr) - (file-remote-p (file-truename tmp-name1) 'localname))) - (delete-file tmp-name2)) - (file-error - (should (string-equal (error-message-string err) - "make-symbolic-link not supported")))) - - ;; Check, that "//" in symlinks are handled properly. - (with-temp-buffer - (let ((default-directory tramp-test-temporary-file-directory)) - (shell-command - (format - "ln -s %s %s" - (tramp-file-name-localname (tramp-dissect-file-name tmp-name3)) - (tramp-file-name-localname (tramp-dissect-file-name tmp-name2))) - t))) - (when (file-symlink-p tmp-name2) - (setq attr (file-attributes tmp-name2)) - (should - (string-equal - (car attr) - (tramp-file-name-localname (tramp-dissect-file-name tmp-name3)))) - (delete-file tmp-name2)) - - (delete-file tmp-name1) - (make-directory tmp-name1) - (should (file-exists-p tmp-name1)) - (should (file-readable-p tmp-name1)) - (should-not (file-regular-p tmp-name1)) - (setq attr (file-attributes tmp-name1)) - (should (eq (car attr) t))) - - ;; Cleanup. - (ignore-errors (delete-directory tmp-name1)) - (ignore-errors (delete-file tmp-name1)) - (ignore-errors (delete-file tmp-name2))))) - -(ert-deftest tramp-test19-directory-files-and-attributes () - "Check `directory-files-and-attributes'." - (skip-unless (tramp--test-enabled)) - - ;; `directory-files-and-attributes' contains also values for "../". - ;; Ensure that this doesn't change during tests, for - ;; example due to handling temporary files. - (let* ((tmp-name1 (tramp--test-make-temp-name)) - (tmp-name2 (expand-file-name "bla" tmp-name1)) - attr) - (unwind-protect - (progn - (make-directory tmp-name1) - (should (file-directory-p tmp-name1)) - (make-directory tmp-name2) - (should (file-directory-p tmp-name2)) - (write-region "foo" nil (expand-file-name "foo" tmp-name2)) - (write-region "bar" nil (expand-file-name "bar" tmp-name2)) - (write-region "boz" nil (expand-file-name "boz" tmp-name2)) - (setq attr (directory-files-and-attributes tmp-name2)) - (should (consp attr)) - ;; Dumb remote shells without perl(1) or stat(1) are not - ;; able to return the date correctly. They say "don't know". - (dolist (elt attr) - (unless - (equal - (nth 5 - (file-attributes (expand-file-name (car elt) tmp-name2))) - '(0 0)) - (should - (equal (file-attributes (expand-file-name (car elt) tmp-name2)) - (cdr elt))))) - (setq attr (directory-files-and-attributes tmp-name2 'full)) - (dolist (elt attr) - (unless (equal (nth 5 (file-attributes (car elt))) '(0 0)) - (should - (equal (file-attributes (car elt)) (cdr elt))))) - (setq attr (directory-files-and-attributes tmp-name2 nil "^b")) - (should (equal (mapcar 'car attr) '("bar" "boz")))) - - ;; Cleanup. - (ignore-errors (delete-directory tmp-name1 'recursive))))) - -(ert-deftest tramp-test20-file-modes () - "Check `file-modes'. -This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." - (skip-unless (tramp--test-enabled)) - (skip-unless - (not - (memq - (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory) - '(tramp-adb-file-name-handler - tramp-gvfs-file-name-handler - tramp-smb-file-name-handler)))) - - (let ((tmp-name (tramp--test-make-temp-name))) - (unwind-protect - (progn - (write-region "foo" nil tmp-name) - (should (file-exists-p tmp-name)) - (set-file-modes tmp-name #o777) - (should (= (file-modes tmp-name) #o777)) - (should (file-executable-p tmp-name)) - (should (file-writable-p tmp-name)) - (set-file-modes tmp-name #o444) - (should (= (file-modes tmp-name) #o444)) - (should-not (file-executable-p tmp-name)) - ;; A file is always writable for user "root". - (unless (zerop (nth 2 (file-attributes tmp-name))) - (should-not (file-writable-p tmp-name)))) - - ;; Cleanup. - (ignore-errors (delete-file tmp-name))))) - -(ert-deftest tramp-test21-file-links () - "Check `file-symlink-p'. -This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." - (skip-unless (tramp--test-enabled)) - - ;; We must use `file-truename' for the temporary directory, because - ;; it could be located on a symlinked directory. This would let the - ;; test fail. - (let* ((tramp-test-temporary-file-directory - (file-truename tramp-test-temporary-file-directory)) - (tmp-name1 (tramp--test-make-temp-name)) - (tmp-name2 (tramp--test-make-temp-name)) - (tmp-name3 (tramp--test-make-temp-name 'local))) - - ;; Check `make-symbolic-link'. - (unwind-protect - (progn - (write-region "foo" nil tmp-name1) - (should (file-exists-p tmp-name1)) - ;; Method "smb" supports `make-symbolic-link' only if the - ;; remote host has CIFS capabilities. tramp-adb.el and - ;; tramp-gvfs.el do not support symbolic links at all. - (condition-case err - (make-symbolic-link tmp-name1 tmp-name2) - (file-error - (skip-unless - (not (string-equal (error-message-string err) - "make-symbolic-link not supported"))))) - (should (file-symlink-p tmp-name2)) - (should-error (make-symbolic-link tmp-name1 tmp-name2)) - (make-symbolic-link tmp-name1 tmp-name2 'ok-if-already-exists) - (should (file-symlink-p tmp-name2)) - ;; `tmp-name3' is a local file name. - (should-error (make-symbolic-link tmp-name1 tmp-name3))) - - ;; Cleanup. - (ignore-errors - (delete-file tmp-name1) - (delete-file tmp-name2))) - - ;; Check `add-name-to-file'. - (unwind-protect - (progn - (write-region "foo" nil tmp-name1) - (should (file-exists-p tmp-name1)) - (add-name-to-file tmp-name1 tmp-name2) - (should-not (file-symlink-p tmp-name2)) - (should-error (add-name-to-file tmp-name1 tmp-name2)) - (add-name-to-file tmp-name1 tmp-name2 'ok-if-already-exists) - (should-not (file-symlink-p tmp-name2)) - ;; `tmp-name3' is a local file name. - (should-error (add-name-to-file tmp-name1 tmp-name3))) - - ;; Cleanup. - (ignore-errors - (delete-file tmp-name1) - (delete-file tmp-name2))) - - ;; Check `file-truename'. - (unwind-protect - (progn - (write-region "foo" nil tmp-name1) - (should (file-exists-p tmp-name1)) - (make-symbolic-link tmp-name1 tmp-name2) - (should (file-symlink-p tmp-name2)) - (should-not (string-equal tmp-name2 (file-truename tmp-name2))) - (should - (string-equal (file-truename tmp-name1) (file-truename tmp-name2))) - (should (file-equal-p tmp-name1 tmp-name2))) - (ignore-errors - (delete-file tmp-name1) - (delete-file tmp-name2))) - - ;; `file-truename' shall preserve trailing link of directories. - (unless (file-symlink-p tramp-test-temporary-file-directory) - (let* ((dir1 (directory-file-name tramp-test-temporary-file-directory)) - (dir2 (file-name-as-directory dir1))) - (should (string-equal (file-truename dir1) (expand-file-name dir1))) - (should (string-equal (file-truename dir2) (expand-file-name dir2))))))) - -(ert-deftest tramp-test22-file-times () - "Check `set-file-times' and `file-newer-than-file-p'." - (skip-unless (tramp--test-enabled)) - (skip-unless - (not - (memq - (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory) - '(tramp-gvfs-file-name-handler tramp-smb-file-name-handler)))) - - (let ((tmp-name1 (tramp--test-make-temp-name)) - (tmp-name2 (tramp--test-make-temp-name)) - (tmp-name3 (tramp--test-make-temp-name))) - (unwind-protect - (progn - (write-region "foo" nil tmp-name1) - (should (file-exists-p tmp-name1)) - (should (consp (nth 5 (file-attributes tmp-name1)))) - ;; '(0 0) means don't know, and will be replaced by - ;; `current-time'. Therefore, we use '(0 1). - ;; We skip the test, if the remote handler is not able to - ;; set the correct time. - (skip-unless (set-file-times tmp-name1 '(0 1))) - ;; Dumb remote shells without perl(1) or stat(1) are not - ;; able to return the date correctly. They say "don't know". - (unless (equal (nth 5 (file-attributes tmp-name1)) '(0 0)) - (should (equal (nth 5 (file-attributes tmp-name1)) '(0 1))) - (write-region "bla" nil tmp-name2) - (should (file-exists-p tmp-name2)) - (should (file-newer-than-file-p tmp-name2 tmp-name1)) - ;; `tmp-name3' does not exist. - (should (file-newer-than-file-p tmp-name2 tmp-name3)) - (should-not (file-newer-than-file-p tmp-name3 tmp-name1)))) - - ;; Cleanup. - (ignore-errors - (delete-file tmp-name1) - (delete-file tmp-name2))))) - -(ert-deftest tramp-test23-visited-file-modtime () - "Check `set-visited-file-modtime' and `verify-visited-file-modtime'." - (skip-unless (tramp--test-enabled)) - - (let ((tmp-name (tramp--test-make-temp-name))) - (unwind-protect - (progn - (write-region "foo" nil tmp-name) - (should (file-exists-p tmp-name)) - (with-temp-buffer - (insert-file-contents tmp-name) - (should (verify-visited-file-modtime)) - (set-visited-file-modtime '(0 1)) - (should (verify-visited-file-modtime)) - (should (equal (visited-file-modtime) '(0 1 0 0))))) - - ;; Cleanup. - (ignore-errors (delete-file tmp-name))))) - -(ert-deftest tramp-test24-file-name-completion () - "Check `file-name-completion' and `file-name-all-completions'." - (skip-unless (tramp--test-enabled)) - - (let ((tmp-name (tramp--test-make-temp-name))) - (unwind-protect - (progn - (make-directory tmp-name) - (should (file-directory-p tmp-name)) - (write-region "foo" nil (expand-file-name "foo" tmp-name)) - (write-region "bar" nil (expand-file-name "bold" tmp-name)) - (make-directory (expand-file-name "boz" tmp-name)) - (should (equal (file-name-completion "fo" tmp-name) "foo")) - (should (equal (file-name-completion "b" tmp-name) "bo")) - (should - (equal (file-name-completion "b" tmp-name 'file-directory-p) "boz/")) - (should (equal (file-name-all-completions "fo" tmp-name) '("foo"))) - (should - (equal (sort (file-name-all-completions "b" tmp-name) 'string-lessp) - '("bold" "boz/")))) - - ;; Cleanup. - (ignore-errors (delete-directory tmp-name 'recursive))))) - -(ert-deftest tramp-test25-load () - "Check `load'." - (skip-unless (tramp--test-enabled)) - - (let ((tmp-name (tramp--test-make-temp-name))) - (unwind-protect - (progn - (load tmp-name 'noerror 'nomessage) - (should-not (featurep 'tramp-test-load)) - (write-region "(provide 'tramp-test-load)" nil tmp-name) - ;; `load' in lread.c does not pass `must-suffix'. Why? - ;(should-error (load tmp-name nil 'nomessage 'nosuffix 'must-suffix)) - (load tmp-name nil 'nomessage 'nosuffix) - (should (featurep 'tramp-test-load))) - - ;; Cleanup. - (ignore-errors - (and (featurep 'tramp-test-load) (unload-feature 'tramp-test-load)) - (delete-file tmp-name))))) - -(ert-deftest tramp-test26-process-file () - "Check `process-file'." - :tags '(:expensive-test) - (skip-unless (tramp--test-enabled)) - (skip-unless - (not - (memq - (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory) - '(tramp-gvfs-file-name-handler tramp-smb-file-name-handler)))) - - (let* ((tmp-name (tramp--test-make-temp-name)) - (fnnd (file-name-nondirectory tmp-name)) - (default-directory tramp-test-temporary-file-directory) - kill-buffer-query-functions) - (unwind-protect - (progn - ;; We cannot use "/bin/true" and "/bin/false"; those paths - ;; do not exist on hydra. - (should (zerop (process-file "true"))) - (should-not (zerop (process-file "false"))) - (should-not (zerop (process-file "binary-does-not-exist"))) - (with-temp-buffer - (write-region "foo" nil tmp-name) - (should (file-exists-p tmp-name)) - (should (zerop (process-file "ls" nil t nil fnnd))) - ;; `ls' could produce colorized output. - (goto-char (point-min)) - (while (re-search-forward tramp-color-escape-sequence-regexp nil t) - (replace-match "" nil nil)) - (should (string-equal (format "%s\n" fnnd) (buffer-string))) - (should-not (get-buffer-window (current-buffer) t)) - - ;; Second run. The output must be appended. - (goto-char (point-max)) - (should (zerop (process-file "ls" nil t t fnnd))) - ;; `ls' could produce colorized output. - (goto-char (point-min)) - (while (re-search-forward tramp-color-escape-sequence-regexp nil t) - (replace-match "" nil nil)) - (should - (string-equal (format "%s\n%s\n" fnnd fnnd) (buffer-string))) - ;; A non-nil DISPLAY must not raise the buffer. - (should-not (get-buffer-window (current-buffer) t)))) - - ;; Cleanup. - (ignore-errors (delete-file tmp-name))))) - -(ert-deftest tramp-test27-start-file-process () - "Check `start-file-process'." - :tags '(:expensive-test) - (skip-unless (tramp--test-enabled)) - (skip-unless - (not - (memq - (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory) - '(tramp-adb-file-name-handler - tramp-gvfs-file-name-handler - tramp-smb-file-name-handler)))) - - (let ((default-directory tramp-test-temporary-file-directory) - (tmp-name (tramp--test-make-temp-name)) - kill-buffer-query-functions proc) - (unwind-protect - (with-temp-buffer - (setq proc (start-file-process "test1" (current-buffer) "cat")) - (should (processp proc)) - (should (equal (process-status proc) 'run)) - (process-send-string proc "foo") - (process-send-eof proc) - ;; Read output. - (with-timeout (10 (ert-fail "`start-file-process' timed out")) - (while (< (- (point-max) (point-min)) (length "foo")) - (accept-process-output proc 1))) - (should (string-equal (buffer-string) "foo"))) - - ;; Cleanup. - (ignore-errors (delete-process proc))) - - (unwind-protect - (with-temp-buffer - (write-region "foo" nil tmp-name) - (should (file-exists-p tmp-name)) - (setq proc - (start-file-process - "test2" (current-buffer) - "cat" (file-name-nondirectory tmp-name))) - (should (processp proc)) - ;; Read output. - (with-timeout (10 (ert-fail "`start-file-process' timed out")) - (while (< (- (point-max) (point-min)) (length "foo")) - (accept-process-output proc 1))) - (should (string-equal (buffer-string) "foo"))) - - ;; Cleanup. - (ignore-errors - (delete-process proc) - (delete-file tmp-name))) - - (unwind-protect - (with-temp-buffer - (setq proc (start-file-process "test3" (current-buffer) "cat")) - (should (processp proc)) - (should (equal (process-status proc) 'run)) - (set-process-filter - proc - (lambda (p s) (with-current-buffer (process-buffer p) (insert s)))) - (process-send-string proc "foo") - (process-send-eof proc) - ;; Read output. - (with-timeout (10 (ert-fail "`start-file-process' timed out")) - (while (< (- (point-max) (point-min)) (length "foo")) - (accept-process-output proc 1))) - (should (string-equal (buffer-string) "foo"))) - - ;; Cleanup. - (ignore-errors (delete-process proc))))) - -(ert-deftest tramp-test28-shell-command () - "Check `shell-command'." - :tags '(:expensive-test) - (skip-unless (tramp--test-enabled)) - (skip-unless - (not - (memq - (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory) - '(tramp-adb-file-name-handler - tramp-gvfs-file-name-handler - tramp-smb-file-name-handler)))) - - (let ((tmp-name (tramp--test-make-temp-name)) - (default-directory tramp-test-temporary-file-directory) - kill-buffer-query-functions) - (unwind-protect - (with-temp-buffer - (write-region "foo" nil tmp-name) - (should (file-exists-p tmp-name)) - (shell-command - (format "ls %s" (file-name-nondirectory tmp-name)) (current-buffer)) - ;; `ls' could produce colorized output. - (goto-char (point-min)) - (while (re-search-forward tramp-color-escape-sequence-regexp nil t) - (replace-match "" nil nil)) - (should - (string-equal - (format "%s\n" (file-name-nondirectory tmp-name)) (buffer-string)))) - - ;; Cleanup. - (ignore-errors (delete-file tmp-name))) - - (unwind-protect - (with-temp-buffer - (write-region "foo" nil tmp-name) - (should (file-exists-p tmp-name)) - (async-shell-command - (format "ls %s" (file-name-nondirectory tmp-name)) (current-buffer)) - (set-process-sentinel (get-buffer-process (current-buffer)) nil) - ;; Read output. - (with-timeout (10 (ert-fail "`async-shell-command' timed out")) - (while (< (- (point-max) (point-min)) - (1+ (length (file-name-nondirectory tmp-name)))) - (accept-process-output (get-buffer-process (current-buffer)) 1))) - ;; `ls' could produce colorized output. - (goto-char (point-min)) - (while (re-search-forward tramp-color-escape-sequence-regexp nil t) - (replace-match "" nil nil)) - ;; There might be a nasty "Process *Async Shell* finished" message. - (goto-char (point-min)) - (forward-line) - (narrow-to-region (point-min) (point)) - (should - (string-equal - (format "%s\n" (file-name-nondirectory tmp-name)) (buffer-string)))) - - ;; Cleanup. - (ignore-errors (delete-file tmp-name))) - - (unwind-protect - (with-temp-buffer - (write-region "foo" nil tmp-name) - (should (file-exists-p tmp-name)) - (async-shell-command "read line; ls $line" (current-buffer)) - (set-process-sentinel (get-buffer-process (current-buffer)) nil) - (process-send-string - (get-buffer-process (current-buffer)) - (format "%s\n" (file-name-nondirectory tmp-name))) - ;; Read output. - (with-timeout (10 (ert-fail "`async-shell-command' timed out")) - (while (< (- (point-max) (point-min)) - (1+ (length (file-name-nondirectory tmp-name)))) - (accept-process-output (get-buffer-process (current-buffer)) 1))) - ;; `ls' could produce colorized output. - (goto-char (point-min)) - (while (re-search-forward tramp-color-escape-sequence-regexp nil t) - (replace-match "" nil nil)) - ;; There might be a nasty "Process *Async Shell* finished" message. - (goto-char (point-min)) - (forward-line) - (narrow-to-region (point-min) (point)) - (should - (string-equal - (format "%s\n" (file-name-nondirectory tmp-name)) (buffer-string)))) - - ;; Cleanup. - (ignore-errors (delete-file tmp-name))))) - -(defun tramp-test--shell-command-to-string-asynchronously (command) - "Like `shell-command-to-string', but for asynchronous processes." - (with-temp-buffer - (async-shell-command command (current-buffer)) - ;; Suppress nasty messages. - (set-process-sentinel (get-buffer-process (current-buffer)) nil) - (while (get-buffer-process (current-buffer)) - (accept-process-output (get-buffer-process (current-buffer)) 0.1)) - (accept-process-output) - (buffer-substring-no-properties (point-min) (point-max)))) - -;; This test is inspired by Bug#23952. -(ert-deftest tramp-test29-environment-variables () - "Check that remote processes set / unset environment variables properly." - :tags '(:expensive-test) - (skip-unless (tramp--test-enabled)) - (skip-unless - (eq - (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory) - 'tramp-sh-file-name-handler)) - - (dolist (this-shell-command-to-string - '(;; Synchronously. - shell-command-to-string - ;; Asynchronously. - tramp-test--shell-command-to-string-asynchronously)) - - (let ((default-directory tramp-test-temporary-file-directory) - (shell-file-name "/bin/sh") - (envvar (concat "VAR_" (upcase (md5 (current-time-string))))) - kill-buffer-query-functions) - - (unwind-protect - ;; Set a value. - (let ((process-environment - (cons (concat envvar "=foo") process-environment))) - ;; Default value. - (should - (string-match - "foo" - (funcall - this-shell-command-to-string - (format "echo -n ${%s:?bla}" envvar)))))) - - (unwind-protect - ;; Set the empty value. - (let ((process-environment - (cons (concat envvar "=") process-environment))) - ;; Value is null. - (should - (string-match - "bla" - (funcall - this-shell-command-to-string - (format "echo -n ${%s:?bla}" envvar)))) - ;; Variable is set. - (should - (string-match - (regexp-quote envvar) - (funcall this-shell-command-to-string "set"))))) - - ;; We force a reconnect, in order to have a clean environment. - (tramp-cleanup-connection - (tramp-dissect-file-name tramp-test-temporary-file-directory) - 'keep-debug 'keep-password) - (unwind-protect - ;; Unset the variable. - (let ((tramp-remote-process-environment - (cons (concat envvar "=foo") - tramp-remote-process-environment))) - ;; Set the initial value, we want to unset below. - (should - (string-match - "foo" - (funcall - this-shell-command-to-string - (format "echo -n ${%s:?bla}" envvar)))) - (let ((process-environment - (cons envvar process-environment))) - ;; Variable is unset. - (should - (string-match - "bla" - (funcall - this-shell-command-to-string - (format "echo -n ${%s:?bla}" envvar)))) - ;; Variable is unset. - (should-not - (string-match - (regexp-quote envvar) - (funcall this-shell-command-to-string "set"))))))))) - -(ert-deftest tramp-test30-vc-registered () - "Check `vc-registered'." - :tags '(:expensive-test) - (skip-unless (tramp--test-enabled)) - (skip-unless - (eq - (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory) - 'tramp-sh-file-name-handler)) - - (let* ((default-directory tramp-test-temporary-file-directory) - (tmp-name1 (tramp--test-make-temp-name)) - (tmp-name2 (expand-file-name "foo" tmp-name1)) - (tramp-remote-process-environment tramp-remote-process-environment) - (vc-handled-backends - (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil - (cond - ((tramp-find-executable v vc-git-program (tramp-get-remote-path v)) - '(Git)) - ((tramp-find-executable v vc-hg-program (tramp-get-remote-path v)) - '(Hg)) - ((tramp-find-executable v vc-bzr-program (tramp-get-remote-path v)) - (setq tramp-remote-process-environment - (cons (format "BZR_HOME=%s" - (file-remote-p tmp-name1 'localname)) - tramp-remote-process-environment)) - ;; We must force a reconnect, in order to activate $BZR_HOME. - (tramp-cleanup-connection - (tramp-dissect-file-name tramp-test-temporary-file-directory) - nil 'keep-password) - '(Bzr)) - (t nil))))) - (skip-unless vc-handled-backends) - (message "%s" vc-handled-backends) - - (unwind-protect - (progn - (make-directory tmp-name1) - (write-region "foo" nil tmp-name2) - (should (file-directory-p tmp-name1)) - (should (file-exists-p tmp-name2)) - (should-not (vc-registered tmp-name1)) - (should-not (vc-registered tmp-name2)) - - (let ((default-directory tmp-name1)) - ;; Create empty repository, and register the file. - ;; Sometimes, creation of repository fails (bzr!); we skip - ;; the test then. - (condition-case nil - (vc-create-repo (car vc-handled-backends)) - (error (skip-unless nil))) - ;; The structure of VC-FILESET is not documented. Let's - ;; hope it won't change. - (condition-case nil - (vc-register - (list (car vc-handled-backends) - (list (file-name-nondirectory tmp-name2)))) - ;; `vc-register' has changed its arguments in Emacs 25.1. - (error - (vc-register - nil (list (car vc-handled-backends) - (list (file-name-nondirectory tmp-name2)))))) - ;; vc-git uses an own process sentinel, Tramp's sentinel - ;; for flushing the cache isn't used. - (dired-uncache (concat (file-remote-p default-directory) "/")) - (should (vc-registered (file-name-nondirectory tmp-name2))))) - - ;; Cleanup. - (ignore-errors (delete-directory tmp-name1 'recursive))))) - -(ert-deftest tramp-test31-make-auto-save-file-name () - "Check `make-auto-save-file-name'." - (skip-unless (tramp--test-enabled)) - - (let ((tmp-name1 (tramp--test-make-temp-name)) - (tmp-name2 (tramp--test-make-temp-name))) - - (unwind-protect - (progn - ;; Use default `auto-save-file-name-transforms' mechanism. - (let (tramp-auto-save-directory) - (with-temp-buffer - (setq buffer-file-name tmp-name1) - (should - (string-equal - (make-auto-save-file-name) - ;; This is taken from original `make-auto-save-file-name'. - (expand-file-name - (format - "#%s#" - (subst-char-in-string - ?/ ?! (replace-regexp-in-string "!" "!!" tmp-name1))) - temporary-file-directory))))) - - ;; No mapping. - (let (tramp-auto-save-directory auto-save-file-name-transforms) - (with-temp-buffer - (setq buffer-file-name tmp-name1) - (should - (string-equal - (make-auto-save-file-name) - (expand-file-name - (format "#%s#" (file-name-nondirectory tmp-name1)) - tramp-test-temporary-file-directory))))) - - ;; Use default `tramp-auto-save-directory' mechanism. - (let ((tramp-auto-save-directory tmp-name2)) - (with-temp-buffer - (setq buffer-file-name tmp-name1) - (should - (string-equal - (make-auto-save-file-name) - ;; This is taken from Tramp. - (expand-file-name - (format - "#%s#" - (tramp-subst-strs-in-string - '(("_" . "|") - ("/" . "_a") - (":" . "_b") - ("|" . "__") - ("[" . "_l") - ("]" . "_r")) - tmp-name1)) - tmp-name2))) - (should (file-directory-p tmp-name2)))) - - ;; Relative file names shall work, too. - (let ((tramp-auto-save-directory ".")) - (with-temp-buffer - (setq buffer-file-name tmp-name1 - default-directory tmp-name2) - (should - (string-equal - (make-auto-save-file-name) - ;; This is taken from Tramp. - (expand-file-name - (format - "#%s#" - (tramp-subst-strs-in-string - '(("_" . "|") - ("/" . "_a") - (":" . "_b") - ("|" . "__") - ("[" . "_l") - ("]" . "_r")) - tmp-name1)) - tmp-name2))) - (should (file-directory-p tmp-name2))))) - - ;; Cleanup. - (ignore-errors (delete-file tmp-name1)) - (ignore-errors (delete-directory tmp-name2 'recursive))))) - -(defun tramp--test-adb-p () - "Check, whether the remote host runs Android. -This requires restrictions of file name syntax." - (tramp-adb-file-name-p tramp-test-temporary-file-directory)) - -(defun tramp--test-ftp-p () - "Check, whether an FTP-like method is used. -This does not support globbing characters in file names (yet)." - ;; Globbing characters are ??, ?* and ?\[. - (and (eq (tramp-find-foreign-file-name-handler - tramp-test-temporary-file-directory) - 'tramp-sh-file-name-handler) - (string-match - "ftp$" (file-remote-p tramp-test-temporary-file-directory 'method)))) - -(defun tramp--test-gvfs-p () - "Check, whether the remote host runs a GVFS based method. -This requires restrictions of file name syntax." - (tramp-gvfs-file-name-p tramp-test-temporary-file-directory)) - -(defun tramp--test-smb-or-windows-nt-p () - "Check, whether the locale or remote host runs MS Windows. -This requires restrictions of file name syntax." - (or (eq system-type 'windows-nt) - (tramp-smb-file-name-p tramp-test-temporary-file-directory))) - -(defun tramp--test-hpux-p () - "Check, whether the remote host runs HP-UX. -Several special characters do not work properly there." - ;; We must refill the cache. `file-truename' does it. - (with-parsed-tramp-file-name - (file-truename tramp-test-temporary-file-directory) nil - (string-match "^HP-UX" (tramp-get-connection-property v "uname" "")))) - -(defun tramp--test-check-files (&rest files) - "Run a simple but comprehensive test over every file in FILES." - ;; We must use `file-truename' for the temporary directory, because - ;; it could be located on a symlinked directory. This would let the - ;; test fail. - (let* ((tramp-test-temporary-file-directory - (file-truename tramp-test-temporary-file-directory)) - (tmp-name1 (tramp--test-make-temp-name)) - (tmp-name2 (tramp--test-make-temp-name 'local)) - (files (delq nil files))) - (unwind-protect - (progn - (make-directory tmp-name1) - (make-directory tmp-name2) - (dolist (elt files) - (let* ((file1 (expand-file-name elt tmp-name1)) - (file2 (expand-file-name elt tmp-name2)) - (file3 (expand-file-name (concat elt "foo") tmp-name1))) - (write-region elt nil file1) - (should (file-exists-p file1)) - - ;; Check file contents. - (with-temp-buffer - (insert-file-contents file1) - (should (string-equal (buffer-string) elt))) - - ;; Copy file both directions. - (copy-file file1 tmp-name2) - (should (file-exists-p file2)) - (delete-file file1) - (should-not (file-exists-p file1)) - (copy-file file2 tmp-name1) - (should (file-exists-p file1)) - - ;; Method "smb" supports `make-symbolic-link' only if the - ;; remote host has CIFS capabilities. tramp-adb.el and - ;; tramp-gvfs.el do not support symbolic links at all. - (condition-case err - (progn - (make-symbolic-link file1 file3) - (should (file-symlink-p file3)) - (should - (string-equal - (expand-file-name file1) (file-truename file3))) - (should - (string-equal - (car (file-attributes file3)) - (file-remote-p (file-truename file1) 'localname))) - ;; Check file contents. - (with-temp-buffer - (insert-file-contents file3) - (should (string-equal (buffer-string) elt))) - (delete-file file3)) - (file-error - (should (string-equal (error-message-string err) - "make-symbolic-link not supported")))))) - - ;; Check file names. - (should (equal (directory-files - tmp-name1 nil directory-files-no-dot-files-regexp) - (sort (copy-sequence files) 'string-lessp))) - (should (equal (directory-files - tmp-name2 nil directory-files-no-dot-files-regexp) - (sort (copy-sequence files) 'string-lessp))) - - ;; `substitute-in-file-name' could return different values. - ;; For `adb', there could be strange file permissions - ;; preventing overwriting a file. We don't care in this - ;; testcase. - (dolist (elt files) - (let ((file1 - (substitute-in-file-name (expand-file-name elt tmp-name1))) - (file2 - (substitute-in-file-name (expand-file-name elt tmp-name2)))) - (ignore-errors (write-region elt nil file1)) - (should (file-exists-p file1)) - (ignore-errors (write-region elt nil file2 nil 'nomessage)) - (should (file-exists-p file2)))) - - (should (equal (directory-files - tmp-name1 nil directory-files-no-dot-files-regexp) - (directory-files - tmp-name2 nil directory-files-no-dot-files-regexp))) - - ;; Check directory creation. We use a subdirectory "foo" - ;; in order to avoid conflicts with previous file name tests. - (dolist (elt files) - (let* ((elt1 (concat elt "foo")) - (file1 (expand-file-name (concat "foo/" elt) tmp-name1)) - (file2 (expand-file-name elt file1)) - (file3 (expand-file-name elt1 file1))) - (make-directory file1 'parents) - (should (file-directory-p file1)) - (write-region elt nil file2) - (should (file-exists-p file2)) - (should - (equal - (directory-files file1 nil directory-files-no-dot-files-regexp) - `(,elt))) - (should - (equal - (caar (directory-files-and-attributes - file1 nil directory-files-no-dot-files-regexp)) - elt)) - - ;; Check symlink in `directory-files-and-attributes'. - (condition-case err - (progn - (make-symbolic-link file2 file3) - (should (file-symlink-p file3)) - (should - (string-equal - (caar (directory-files-and-attributes - file1 nil (regexp-quote elt1))) - elt1)) - (should - (string-equal - (cadr (car (directory-files-and-attributes - file1 nil (regexp-quote elt1)))) - (file-remote-p (file-truename file2) 'localname))) - (delete-file file3) - (should-not (file-exists-p file3))) - (file-error - (should (string-equal (error-message-string err) - "make-symbolic-link not supported")))) - - (delete-file file2) - (should-not (file-exists-p file2)) - (delete-directory file1) - (should-not (file-exists-p file1))))) - - ;; Cleanup. - (ignore-errors (delete-directory tmp-name1 'recursive)) - (ignore-errors (delete-directory tmp-name2 'recursive))))) - -(defun tramp--test-special-characters () - "Perform the test in `tramp-test32-special-characters*'." - ;; Newlines, slashes and backslashes in file names are not - ;; supported. So we don't test. And we don't test the tab - ;; character on Windows or Cygwin, because the backslash is - ;; interpreted as a path separator, preventing "\t" from being - ;; expanded to . - (tramp--test-check-files - (if (or (tramp--test-gvfs-p) (tramp--test-smb-or-windows-nt-p)) - "foo bar baz" - (if (or (tramp--test-adb-p) (eq system-type 'cygwin)) - " foo bar baz " - " foo\tbar baz\t")) - "$foo$bar$$baz$" - "-foo-bar-baz-" - "%foo%bar%baz%" - "&foo&bar&baz&" - (unless (or (tramp--test-ftp-p) - (tramp--test-gvfs-p) - (tramp--test-smb-or-windows-nt-p)) - "?foo?bar?baz?") - (unless (or (tramp--test-ftp-p) - (tramp--test-gvfs-p) - (tramp--test-smb-or-windows-nt-p)) - "*foo*bar*baz*") - (if (or (tramp--test-gvfs-p) (tramp--test-smb-or-windows-nt-p)) - "'foo'bar'baz'" - "'foo\"bar'baz\"") - "#foo~bar#baz~" - (if (or (tramp--test-gvfs-p) (tramp--test-smb-or-windows-nt-p)) - "!foo!bar!baz!" - "!foo|bar!baz|") - (if (or (tramp--test-gvfs-p) (tramp--test-smb-or-windows-nt-p)) - ";foo;bar;baz;" - ":foo;bar:baz;") - (unless (or (tramp--test-gvfs-p) (tramp--test-smb-or-windows-nt-p)) - "bar") - "(foo)bar(baz)" - (unless (or (tramp--test-ftp-p) (tramp--test-gvfs-p)) "[foo]bar[baz]") - "{foo}bar{baz}")) - -;; These tests are inspired by Bug#17238. -(ert-deftest tramp-test32-special-characters () - "Check special characters in file names." - (skip-unless (tramp--test-enabled)) - - (tramp--test-special-characters)) - -(ert-deftest tramp-test32-special-characters-with-stat () - "Check special characters in file names. -Use the `stat' command." - :tags '(:expensive-test) - (skip-unless (tramp--test-enabled)) - (skip-unless - (eq - (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory) - 'tramp-sh-file-name-handler)) - (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil - (skip-unless (tramp-get-remote-stat v))) - - (let ((tramp-connection-properties - (append - `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) - "perl" nil)) - tramp-connection-properties))) - (tramp--test-special-characters))) - -(ert-deftest tramp-test32-special-characters-with-perl () - "Check special characters in file names. -Use the `perl' command." - :tags '(:expensive-test) - (skip-unless (tramp--test-enabled)) - (skip-unless - (eq - (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory) - 'tramp-sh-file-name-handler)) - (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil - (skip-unless (tramp-get-remote-perl v))) - - (let ((tramp-connection-properties - (append - `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) - "stat" nil) - ;; See `tramp-sh-handle-file-truename'. - (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) - "readlink" nil)) - tramp-connection-properties))) - (tramp--test-special-characters))) - -(ert-deftest tramp-test32-special-characters-with-ls () - "Check special characters in file names. -Use the `ls' command." - :tags '(:expensive-test) - (skip-unless (tramp--test-enabled)) - (skip-unless - (eq - (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory) - 'tramp-sh-file-name-handler)) - - (let ((tramp-connection-properties - (append - `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) - "perl" nil) - (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) - "stat" nil) - ;; See `tramp-sh-handle-file-truename'. - (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) - "readlink" nil)) - tramp-connection-properties))) - (tramp--test-special-characters))) - -(defun tramp--test-utf8 () - "Perform the test in `tramp-test33-utf8*'." - (let* ((utf8 (if (and (eq system-type 'darwin) - (memq 'utf-8-hfs (coding-system-list))) - 'utf-8-hfs 'utf-8)) - (coding-system-for-read utf8) - (coding-system-for-write utf8) - (file-name-coding-system utf8)) - (tramp--test-check-files - (unless (tramp--test-hpux-p) "Γυρίστε το Γαλαξία με Ώτο Στοπ") - (unless (tramp--test-hpux-p) - "أصبح بوسعك الآن تنزيل نسخة كاملة من موسوعة ويكيبيديا العربية لتصفحها بلا اتصال بالإنترنت") - "银河系漫游指南系列" - "Автостопом по гала́ктике"))) - -(ert-deftest tramp-test33-utf8 () - "Check UTF8 encoding in file names and file contents." - (skip-unless (tramp--test-enabled)) - - (tramp--test-utf8)) - -(ert-deftest tramp-test33-utf8-with-stat () - "Check UTF8 encoding in file names and file contents. -Use the `stat' command." - :tags '(:expensive-test) - (skip-unless (tramp--test-enabled)) - (skip-unless - (eq - (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory) - 'tramp-sh-file-name-handler)) - (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil - (skip-unless (tramp-get-remote-stat v))) - - (let ((tramp-connection-properties - (append - `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) - "perl" nil)) - tramp-connection-properties))) - (tramp--test-utf8))) - -(ert-deftest tramp-test33-utf8-with-perl () - "Check UTF8 encoding in file names and file contents. -Use the `perl' command." - :tags '(:expensive-test) - (skip-unless (tramp--test-enabled)) - (skip-unless - (eq - (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory) - 'tramp-sh-file-name-handler)) - (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil - (skip-unless (tramp-get-remote-perl v))) - - (let ((tramp-connection-properties - (append - `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) - "stat" nil) - ;; See `tramp-sh-handle-file-truename'. - (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) - "readlink" nil)) - tramp-connection-properties))) - (tramp--test-utf8))) - -(ert-deftest tramp-test33-utf8-with-ls () - "Check UTF8 encoding in file names and file contents. -Use the `ls' command." - :tags '(:expensive-test) - (skip-unless (tramp--test-enabled)) - (skip-unless - (eq - (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory) - 'tramp-sh-file-name-handler)) - - (let ((tramp-connection-properties - (append - `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) - "perl" nil) - (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) - "stat" nil) - ;; See `tramp-sh-handle-file-truename'. - (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) - "readlink" nil)) - tramp-connection-properties))) - (tramp--test-utf8))) - -;; This test is inspired by Bug#16928. -(ert-deftest tramp-test34-asynchronous-requests () - "Check parallel asynchronous requests. -Such requests could arrive from timers, process filters and -process sentinels. They shall not disturb each other." - ;; Mark as failed until bug has been fixed. - :expected-result :failed - :tags '(:expensive-test) - (skip-unless (tramp--test-enabled)) - (skip-unless - (eq - (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory) - 'tramp-sh-file-name-handler)) - - ;; Keep instrumentation verbosity 0 until Tramp bug is fixed. This - ;; has the side effect, that this test fails instead to abort. Good - ;; for hydra. - (tramp--instrument-test-case 0 - (let* ((tmp-name (tramp--test-make-temp-name)) - (default-directory tmp-name) - (remote-file-name-inhibit-cache t) - timer buffers kill-buffer-query-functions) - - (unwind-protect - (progn - (make-directory tmp-name) - - ;; Setup a timer in order to raise an ordinary command again - ;; and again. `vc-registered' is well suited, because there - ;; are many checks. - (setq - timer - (run-at-time - 0 1 - (lambda () - (when buffers - (vc-registered - (buffer-name (nth (random (length buffers)) buffers))))))) - - ;; Create temporary buffers. The number of buffers - ;; corresponds to the number of processes; it could be - ;; increased in order to make pressure on Tramp. - (dotimes (i 5) - (add-to-list 'buffers (generate-new-buffer "*temp*"))) - - ;; Open asynchronous processes. Set process sentinel. - (dolist (buf buffers) - (async-shell-command "read line; touch $line; echo $line" buf) - (set-process-sentinel - (get-buffer-process buf) - (lambda (proc _state) - (delete-file (buffer-name (process-buffer proc)))))) - - ;; Send a string. Use a random order of the buffers. Mix - ;; with regular operation. - (let ((buffers (copy-sequence buffers)) - buf) - (while buffers - (setq buf (nth (random (length buffers)) buffers)) - (process-send-string - (get-buffer-process buf) (format "'%s'\n" buf)) - (file-attributes (buffer-name buf)) - (setq buffers (delq buf buffers)))) - - ;; Wait until the whole output has been read. - (with-timeout ((* 10 (length buffers)) - (ert-fail "`async-shell-command' timed out")) - (let ((buffers (copy-sequence buffers)) - buf) - (while buffers - (setq buf (nth (random (length buffers)) buffers)) - (if (ignore-errors - (memq (process-status (get-buffer-process buf)) - '(run open))) - (accept-process-output (get-buffer-process buf) 0.1) - (setq buffers (delq buf buffers)))))) - - ;; Check. - (dolist (buf buffers) - (with-current-buffer buf - (should - (string-equal (format "'%s'\n" buf) (buffer-string))))) - (should-not - (directory-files tmp-name nil directory-files-no-dot-files-regexp))) - - ;; Cleanup. - (ignore-errors (cancel-timer timer)) - (ignore-errors (delete-directory tmp-name 'recursive)) - (dolist (buf buffers) - (ignore-errors (kill-buffer buf))))))) - -(ert-deftest tramp-test35-recursive-load () - "Check that Tramp does not fail due to recursive load." - (skip-unless (tramp--test-enabled)) - - (dolist (code - (list - (format - "(expand-file-name %S)" - tramp-test-temporary-file-directory) - (format - "(let ((default-directory %S)) (expand-file-name %S))" - tramp-test-temporary-file-directory - temporary-file-directory))) - (should-not - (string-match - "Recursive load" - (shell-command-to-string - (format - "%s -batch -Q -L %s --eval %s" - (expand-file-name invocation-name invocation-directory) - (mapconcat 'shell-quote-argument load-path " -L ") - (shell-quote-argument code))))))) - -(ert-deftest tramp-test36-unload () - "Check that Tramp and its subpackages unload completely. -Since it unloads Tramp, it shall be the last test to run." - ;; Mark as failed until all symbols are unbound. - :expected-result (if (featurep 'tramp) :failed :passed) - :tags '(:expensive-test) - (when (featurep 'tramp) - (unload-feature 'tramp 'force) - ;; No Tramp feature must be left. - (should-not (featurep 'tramp)) - (should-not (all-completions "tramp" (delq 'tramp-tests features))) - ;; `file-name-handler-alist' must be clean. - (should-not (all-completions "tramp" (mapcar 'cdr file-name-handler-alist))) - ;; There shouldn't be left a bound symbol. We do not regard our - ;; test symbols, and the Tramp unload hooks. - (mapatoms - (lambda (x) - (and (or (boundp x) (functionp x)) - (string-match "^tramp" (symbol-name x)) - (not (string-match "^tramp--?test" (symbol-name x))) - (not (string-match "unload-hook$" (symbol-name x))) - (ert-fail (format "`%s' still bound" x))))) - ;; There shouldn't be left a hook function containing a Tramp - ;; function. We do not regard the Tramp unload hooks. - (mapatoms - (lambda (x) - (and (boundp x) - (string-match "-hooks?$" (symbol-name x)) - (not (string-match "unload-hook$" (symbol-name x))) - (consp (symbol-value x)) - (ignore-errors (all-completions "tramp" (symbol-value x))) - (ert-fail (format "Hook `%s' still contains Tramp function" x))))))) - -;; TODO: - -;; * dired-compress-file -;; * dired-uncache -;; * file-acl -;; * file-ownership-preserved-p -;; * file-selinux-context -;; * find-backup-file-name -;; * set-file-acl -;; * set-file-selinux-context - -;; * Work on skipped tests. Make a comment, when it is impossible. -;; * Fix `tramp-test15-copy-directory' for `smb'. Using tar in a pipe -;; doesn't work well when an interactive password must be provided. -;; * Fix `tramp-test27-start-file-process' on MS Windows (`process-send-eof'?). -;; * Fix Bug#16928. Set expected error of `tramp-test34-asynchronous-requests'. -;; * Fix `tramp-test36-unload' (Not all symbols are unbound). Set -;; expected error. - -(defun tramp-test-all (&optional interactive) - "Run all tests for \\[tramp]." - (interactive "p") - (funcall - (if interactive 'ert-run-tests-interactively 'ert-run-tests-batch) "^tramp")) - -(provide 'tramp-tests) -;;; tramp-tests.el ends here commit 5a59e28dec039453aaad27fd0919bb93ed517079 Author: Paul Eggert Date: Sun Jan 1 01:32:27 2017 -0800 Merge from gnulib This incorporates: 2016-12-19 stdint: Fix WINT_MAX to match wint_t on mingw 2016-12-18 getopt: Fix link error for users of getopt() in 2016-12-17 getlogin: Port to newer mingw 2016-12-17 stdint: Fix WINT_MAX to match wint_t on MSVC 2016-12-17 Avoid redefinition errors on MSVC * lib/getopt.in.h, lib/stdint.in.h, lib/stdio.in.h, lib/unistd.in.h: * m4/stdint.m4, m4/unistd_h.m4: Copy from gnulib. * lib/gnulib.mk, m4/gnulib-comp.m4: Regenerate. Plus, this commit updates the indenting on copyright notices to match that of gnulib. diff --git a/lib/alloca.in.h b/lib/alloca.in.h index aa482589d9..c3dc38a5b9 100644 --- a/lib/alloca.in.h +++ b/lib/alloca.in.h @@ -1,7 +1,7 @@ /* Memory allocation on the stack. - Copyright (C) 1995, 1999, 2001-2004, 2006-2017 Free Software - Foundation, Inc. + Copyright (C) 1995, 1999, 2001-2004, 2006-2017 Free Software Foundation, + Inc. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published diff --git a/lib/binary-io.h b/lib/binary-io.h index da0b47c878..f766439e2f 100644 --- a/lib/binary-io.h +++ b/lib/binary-io.h @@ -1,6 +1,5 @@ /* Binary mode I/O. - Copyright (C) 2001, 2003, 2005, 2008-2017 Free Software Foundation, - Inc. + Copyright (C) 2001, 2003, 2005, 2008-2017 Free Software Foundation, Inc. This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by diff --git a/lib/c-ctype.h b/lib/c-ctype.h index 8d6156b6f6..faf21581ca 100644 --- a/lib/c-ctype.h +++ b/lib/c-ctype.h @@ -5,8 +5,7 @@ functions' behaviour depends on the current locale set via setlocale. - Copyright (C) 2000-2003, 2006, 2008-2017 Free Software Foundation, - Inc. + Copyright (C) 2000-2003, 2006, 2008-2017 Free Software Foundation, Inc. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by diff --git a/lib/c-strcasecmp.c b/lib/c-strcasecmp.c index 0354fa864f..5bce873d7b 100644 --- a/lib/c-strcasecmp.c +++ b/lib/c-strcasecmp.c @@ -1,6 +1,5 @@ /* c-strcasecmp.c -- case insensitive string comparator in C locale - Copyright (C) 1998-1999, 2005-2006, 2009-2017 Free Software - Foundation, Inc. + Copyright (C) 1998-1999, 2005-2006, 2009-2017 Free Software Foundation, Inc. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by diff --git a/lib/c-strncasecmp.c b/lib/c-strncasecmp.c index 9dcf9149ab..ada62d70b7 100644 --- a/lib/c-strncasecmp.c +++ b/lib/c-strncasecmp.c @@ -1,6 +1,5 @@ /* c-strncasecmp.c -- case insensitive string comparator in C locale - Copyright (C) 1998-1999, 2005-2006, 2009-2017 Free Software - Foundation, Inc. + Copyright (C) 1998-1999, 2005-2006, 2009-2017 Free Software Foundation, Inc. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by diff --git a/lib/careadlinkat.c b/lib/careadlinkat.c index 6345a01a3c..455e00efe0 100644 --- a/lib/careadlinkat.c +++ b/lib/careadlinkat.c @@ -1,7 +1,7 @@ /* Read symbolic links into a buffer without size limitation, relative to fd. - Copyright (C) 2001, 2003-2004, 2007, 2009-2017 Free Software - Foundation, Inc. + Copyright (C) 2001, 2003-2004, 2007, 2009-2017 Free Software Foundation, + Inc. This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by diff --git a/lib/close-stream.c b/lib/close-stream.c index 8c5763593d..96c126536c 100644 --- a/lib/close-stream.c +++ b/lib/close-stream.c @@ -1,7 +1,6 @@ /* Close a stream, with nicer error checking than fclose's. - Copyright (C) 1998-2002, 2004, 2006-2017 Free Software Foundation, - Inc. + Copyright (C) 1998-2002, 2004, 2006-2017 Free Software Foundation, Inc. This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by diff --git a/lib/dosname.h b/lib/dosname.h index d5d97413ab..dd5c177725 100644 --- a/lib/dosname.h +++ b/lib/dosname.h @@ -1,7 +1,6 @@ /* File names on MS-DOS/Windows systems. - Copyright (C) 2000-2001, 2004-2006, 2009-2017 Free Software - Foundation, Inc. + Copyright (C) 2000-2001, 2004-2006, 2009-2017 Free Software Foundation, Inc. This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by diff --git a/lib/dup2.c b/lib/dup2.c index 7d593e473f..c0c7cadf4a 100644 --- a/lib/dup2.c +++ b/lib/dup2.c @@ -1,7 +1,6 @@ /* Duplicate an open file descriptor to a specified file descriptor. - Copyright (C) 1999, 2004-2007, 2009-2017 Free Software Foundation, - Inc. + Copyright (C) 1999, 2004-2007, 2009-2017 Free Software Foundation, Inc. This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by diff --git a/lib/filemode.h b/lib/filemode.h index cd263d7095..5fbb79146d 100644 --- a/lib/filemode.h +++ b/lib/filemode.h @@ -1,7 +1,7 @@ /* Make a string describing file modes. - Copyright (C) 1998-1999, 2003, 2006, 2009-2017 Free Software - Foundation, Inc. + Copyright (C) 1998-1999, 2003, 2006, 2009-2017 Free Software Foundation, + Inc. This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by diff --git a/lib/filevercmp.c b/lib/filevercmp.c index a75c9468e3..0396867c7e 100644 --- a/lib/filevercmp.c +++ b/lib/filevercmp.c @@ -1,7 +1,7 @@ /* Copyright (C) 1995 Ian Jackson Copyright (C) 2001 Anthony Towns - Copyright (C) 2008-2016 Free Software Foundation, Inc. + Copyright (C) 2008-2017 Free Software Foundation, Inc. This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by diff --git a/lib/filevercmp.h b/lib/filevercmp.h index 220b71b579..d698991172 100644 --- a/lib/filevercmp.h +++ b/lib/filevercmp.h @@ -1,7 +1,7 @@ /* Copyright (C) 1995 Ian Jackson Copyright (C) 2001 Anthony Towns - Copyright (C) 2008-2016 Free Software Foundation, Inc. + Copyright (C) 2008-2017 Free Software Foundation, Inc. This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by diff --git a/lib/flexmember.h b/lib/flexmember.h index 62c556bae2..c71ea65103 100644 --- a/lib/flexmember.h +++ b/lib/flexmember.h @@ -1,6 +1,6 @@ /* Sizes of structs with flexible array members. - Copyright 2016 Free Software Foundation, Inc. + Copyright 2016-2017 Free Software Foundation, Inc. This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by diff --git a/lib/fpending.c b/lib/fpending.c index 8ead4ac371..8761c77ca6 100644 --- a/lib/fpending.c +++ b/lib/fpending.c @@ -1,6 +1,6 @@ /* fpending.c -- return the number of pending output bytes on a stream - Copyright (C) 2000, 2004, 2006-2007, 2009-2017 Free Software - Foundation, Inc. + Copyright (C) 2000, 2004, 2006-2007, 2009-2017 Free Software Foundation, + Inc. This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by diff --git a/lib/fpending.h b/lib/fpending.h index 480827b146..a901deee4b 100644 --- a/lib/fpending.h +++ b/lib/fpending.h @@ -1,7 +1,7 @@ /* Declare __fpending. - Copyright (C) 2000, 2003, 2005-2006, 2009-2017 Free Software - Foundation, Inc. + Copyright (C) 2000, 2003, 2005-2006, 2009-2017 Free Software Foundation, + Inc. This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by diff --git a/lib/getgroups.c b/lib/getgroups.c index 491d358cb5..dce0f2d003 100644 --- a/lib/getgroups.c +++ b/lib/getgroups.c @@ -1,7 +1,6 @@ /* provide consistent interface to getgroups for systems that don't allow N==0 - Copyright (C) 1996, 1999, 2003, 2006-2017 Free Software Foundation, - Inc. + Copyright (C) 1996, 1999, 2003, 2006-2017 Free Software Foundation, Inc. This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by diff --git a/lib/getloadavg.c b/lib/getloadavg.c index 123dac511b..0fe23bb9a5 100644 --- a/lib/getloadavg.c +++ b/lib/getloadavg.c @@ -1,7 +1,7 @@ /* Get the system load averages. - Copyright (C) 1985-1989, 1991-1995, 1997, 1999-2000, 2003-2017 Free - Software Foundation, Inc. + Copyright (C) 1985-1989, 1991-1995, 1997, 1999-2000, 2003-2017 Free Software + Foundation, Inc. NOTE: The canonical source of this file is maintained with gnulib. Bugs can be reported to bug-gnulib@gnu.org. diff --git a/lib/getopt.in.h b/lib/getopt.in.h index dc2e2f2c54..6cbad8e033 100644 --- a/lib/getopt.in.h +++ b/lib/getopt.in.h @@ -1,6 +1,6 @@ /* Declarations for getopt. - Copyright (C) 1989-1994, 1996-1999, 2001, 2003-2007, 2009-2017 Free - Software Foundation, Inc. + Copyright (C) 1989-1994, 1996-1999, 2001, 2003-2007, 2009-2017 Free Software + Foundation, Inc. This file is part of the GNU C Library. This program is free software: you can redistribute it and/or modify @@ -47,15 +47,20 @@ identifiers so that they do not collide with the system functions and variables. Renaming avoids problems with some compilers and linkers. */ -#if defined __GETOPT_PREFIX && !defined __need_getopt -# if !@HAVE_GETOPT_H@ -# define __need_system_stdlib_h -# include -# undef __need_system_stdlib_h -# include -# include +#if defined __GETOPT_PREFIX +# if !defined __need_getopt +# if !@HAVE_GETOPT_H@ +# define __need_system_stdlib_h +# include +# undef __need_system_stdlib_h +# include +# include +# endif +# undef __need_getopt # endif -# undef __need_getopt +# undef __GETOPT_CONCAT +# undef __GETOPT_XCONCAT +# undef __GETOPT_ID # undef getopt # undef getopt_long # undef getopt_long_only @@ -64,6 +69,7 @@ # undef optind # undef optopt # undef option +# undef _getopt_internal # define __GETOPT_CONCAT(x, y) x ## y # define __GETOPT_XCONCAT(x, y) __GETOPT_CONCAT (x, y) # define __GETOPT_ID(y) __GETOPT_XCONCAT (__GETOPT_PREFIX, y) diff --git a/lib/getopt1.c b/lib/getopt1.c index 55210c8982..4d2e8cbac3 100644 --- a/lib/getopt1.c +++ b/lib/getopt1.c @@ -1,6 +1,6 @@ /* getopt_long and getopt_long_only entry points for GNU getopt. - Copyright (C) 1987-1994, 1996-1998, 2004, 2006, 2009-2017 Free - Software Foundation, Inc. + Copyright (C) 1987-1994, 1996-1998, 2004, 2006, 2009-2017 Free Software + Foundation, Inc. This file is part of the GNU C Library. This program is free software: you can redistribute it and/or modify diff --git a/lib/getopt_int.h b/lib/getopt_int.h index 62103144e8..a7ce0e9cc1 100644 --- a/lib/getopt_int.h +++ b/lib/getopt_int.h @@ -1,6 +1,6 @@ /* Internal declarations for getopt. - Copyright (C) 1989-1994, 1996-1999, 2001, 2003-2004, 2009-2017 Free - Software Foundation, Inc. + Copyright (C) 1989-1994, 1996-1999, 2001, 2003-2004, 2009-2017 Free Software + Foundation, Inc. This file is part of the GNU C Library. This program is free software: you can redistribute it and/or modify diff --git a/lib/gettext.h b/lib/gettext.h index 41ed85ddf6..0465d7ad14 100644 --- a/lib/gettext.h +++ b/lib/gettext.h @@ -1,6 +1,6 @@ /* Convenience header for conditional use of GNU . - Copyright (C) 1995-1998, 2000-2002, 2004-2006, 2009-2017 Free - Software Foundation, Inc. + Copyright (C) 1995-1998, 2000-2002, 2004-2006, 2009-2017 Free Software + Foundation, Inc. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by diff --git a/lib/gettime.c b/lib/gettime.c index b3eb3d38f7..4ae313e78e 100644 --- a/lib/gettime.c +++ b/lib/gettime.c @@ -1,7 +1,6 @@ /* gettime -- get the system clock - Copyright (C) 2002, 2004-2007, 2009-2017 Free Software Foundation, - Inc. + Copyright (C) 2002, 2004-2007, 2009-2017 Free Software Foundation, Inc. This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by diff --git a/lib/gettimeofday.c b/lib/gettimeofday.c index f7e198b01a..18dcbda4db 100644 --- a/lib/gettimeofday.c +++ b/lib/gettimeofday.c @@ -1,7 +1,6 @@ /* Provide gettimeofday for systems that don't have it or for which it's broken. - Copyright (C) 2001-2003, 2005-2007, 2009-2017 Free Software - Foundation, Inc. + Copyright (C) 2001-2003, 2005-2007, 2009-2017 Free Software Foundation, Inc. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by diff --git a/lib/gnulib.mk b/lib/gnulib.mk index eb5155af91..4398fe3717 100644 --- a/lib/gnulib.mk +++ b/lib/gnulib.mk @@ -1054,6 +1054,7 @@ stdint.h: stdint.in.h $(top_builddir)/config.status -e 's/@''BITSIZEOF_WINT_T''@/$(BITSIZEOF_WINT_T)/g' \ -e 's/@''HAVE_SIGNED_WINT_T''@/$(HAVE_SIGNED_WINT_T)/g' \ -e 's/@''WINT_T_SUFFIX''@/$(WINT_T_SUFFIX)/g' \ + -e 's/@''GNULIB_OVERRIDES_WINT_T''@/$(GNULIB_OVERRIDES_WINT_T)/g' \ < $(srcdir)/stdint.in.h; \ } > $@-t && \ mv $@-t $@ @@ -1815,7 +1816,6 @@ unistd.h: unistd.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H -e 's|@''HAVE_GETDTABLESIZE''@|$(HAVE_GETDTABLESIZE)|g' \ -e 's|@''HAVE_GETGROUPS''@|$(HAVE_GETGROUPS)|g' \ -e 's|@''HAVE_GETHOSTNAME''@|$(HAVE_GETHOSTNAME)|g' \ - -e 's|@''HAVE_GETLOGIN''@|$(HAVE_GETLOGIN)|g' \ -e 's|@''HAVE_GETPAGESIZE''@|$(HAVE_GETPAGESIZE)|g' \ -e 's|@''HAVE_GROUP_MEMBER''@|$(HAVE_GROUP_MEMBER)|g' \ -e 's|@''HAVE_LCHOWN''@|$(HAVE_LCHOWN)|g' \ @@ -1837,6 +1837,7 @@ unistd.h: unistd.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H -e 's|@''HAVE_DECL_FCHDIR''@|$(HAVE_DECL_FCHDIR)|g' \ -e 's|@''HAVE_DECL_FDATASYNC''@|$(HAVE_DECL_FDATASYNC)|g' \ -e 's|@''HAVE_DECL_GETDOMAINNAME''@|$(HAVE_DECL_GETDOMAINNAME)|g' \ + -e 's|@''HAVE_DECL_GETLOGIN''@|$(HAVE_DECL_GETLOGIN)|g' \ -e 's|@''HAVE_DECL_GETLOGIN_R''@|$(HAVE_DECL_GETLOGIN_R)|g' \ -e 's|@''HAVE_DECL_GETPAGESIZE''@|$(HAVE_DECL_GETPAGESIZE)|g' \ -e 's|@''HAVE_DECL_GETUSERSHELL''@|$(HAVE_DECL_GETUSERSHELL)|g' \ diff --git a/lib/group-member.c b/lib/group-member.c index d4e2b3b22e..20f8ee8b67 100644 --- a/lib/group-member.c +++ b/lib/group-member.c @@ -1,7 +1,7 @@ /* group-member.c -- determine whether group id is in calling user's group list - Copyright (C) 1994, 1997-1998, 2003, 2005-2006, 2009-2017 Free - Software Foundation, Inc. + Copyright (C) 1994, 1997-1998, 2003, 2005-2006, 2009-2017 Free Software + Foundation, Inc. This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by diff --git a/lib/limits.in.h b/lib/limits.in.h index a1eae02ada..a7e307f5c6 100644 --- a/lib/limits.in.h +++ b/lib/limits.in.h @@ -1,6 +1,6 @@ /* A GNU-like . - Copyright 2016 Free Software Foundation, Inc. + Copyright 2016-2017 Free Software Foundation, Inc. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License diff --git a/lib/md5.c b/lib/md5.c index d576466126..e82b0514a0 100644 --- a/lib/md5.c +++ b/lib/md5.c @@ -1,7 +1,7 @@ /* Functions to compute MD5 message digest of files or memory blocks. according to the definition of MD5 in RFC 1321 from April 1992. - Copyright (C) 1995-1997, 1999-2001, 2005-2006, 2008-2017 Free - Software Foundation, Inc. + Copyright (C) 1995-1997, 1999-2001, 2005-2006, 2008-2017 Free Software + Foundation, Inc. This file is part of the GNU C Library. This program is free software; you can redistribute it and/or modify it diff --git a/lib/md5.h b/lib/md5.h index a486ad7bde..fb20b7b1bc 100644 --- a/lib/md5.h +++ b/lib/md5.h @@ -1,7 +1,7 @@ /* Declaration of functions and data types used for MD5 sum computing library functions. - Copyright (C) 1995-1997, 1999-2001, 2004-2006, 2008-2017 Free - Software Foundation, Inc. + Copyright (C) 1995-1997, 1999-2001, 2004-2006, 2008-2017 Free Software + Foundation, Inc. This file is part of the GNU C Library. This program is free software; you can redistribute it and/or modify it diff --git a/lib/memrchr.c b/lib/memrchr.c index 7f0236cc99..fefe16cc51 100644 --- a/lib/memrchr.c +++ b/lib/memrchr.c @@ -1,7 +1,7 @@ /* memrchr -- find the last occurrence of a byte in a memory block - Copyright (C) 1991, 1993, 1996-1997, 1999-2000, 2003-2017 Free - Software Foundation, Inc. + Copyright (C) 1991, 1993, 1996-1997, 1999-2000, 2003-2017 Free Software + Foundation, Inc. Based on strlen implementation by Torbjorn Granlund (tege@sics.se), with help from Dan Sahlin (dan@sics.se) and diff --git a/lib/mktime-internal.h b/lib/mktime-internal.h index 2f586aef64..6c8b2e7f52 100644 --- a/lib/mktime-internal.h +++ b/lib/mktime-internal.h @@ -1,6 +1,6 @@ /* mktime variant that also uses an offset guess - Copyright 2016 Free Software Foundation, Inc. + Copyright 2016-2017 Free Software Foundation, Inc. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public diff --git a/lib/sha1.c b/lib/sha1.c index 11050ea632..ea0474f2ce 100644 --- a/lib/sha1.c +++ b/lib/sha1.c @@ -1,8 +1,7 @@ /* sha1.c - Functions to compute SHA1 message digest of files or memory blocks according to the NIST specification FIPS-180-1. - Copyright (C) 2000-2001, 2003-2006, 2008-2017 Free Software - Foundation, Inc. + Copyright (C) 2000-2001, 2003-2006, 2008-2017 Free Software Foundation, Inc. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the diff --git a/lib/sig2str.c b/lib/sig2str.c index af171aed06..c50c612b39 100644 --- a/lib/sig2str.c +++ b/lib/sig2str.c @@ -1,7 +1,6 @@ /* sig2str.c -- convert between signal names and numbers - Copyright (C) 2002, 2004, 2006, 2009-2017 Free Software Foundation, - Inc. + Copyright (C) 2002, 2004, 2006, 2009-2017 Free Software Foundation, Inc. This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by diff --git a/lib/stdint.in.h b/lib/stdint.in.h index 90c8a79a56..d899c1e034 100644 --- a/lib/stdint.in.h +++ b/lib/stdint.in.h @@ -83,6 +83,15 @@ LONG_MIN, LONG_MAX, ULONG_MAX, _GL_INTEGER_WIDTH. */ #include +/* Override WINT_MIN and WINT_MAX if gnulib's or overrides + wint_t. */ +#if @GNULIB_OVERRIDES_WINT_T@ +# undef WINT_MIN +# undef WINT_MAX +# define WINT_MIN 0x0U +# define WINT_MAX 0xffffffffU +#endif + #if ! @HAVE_C99_STDINT_H@ /* defines some of the stdint.h types as well, on glibc, diff --git a/lib/stdio-impl.h b/lib/stdio-impl.h index 766d693659..d2d4daa6e1 100644 --- a/lib/stdio-impl.h +++ b/lib/stdio-impl.h @@ -1,5 +1,5 @@ /* Implementation details of FILE streams. - Copyright (C) 2007-2008, 2010-2016 Free Software Foundation, Inc. + Copyright (C) 2007-2008, 2010-2017 Free Software Foundation, Inc. This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by diff --git a/lib/stdio.in.h b/lib/stdio.in.h index 4c7ee55fd0..d706377f98 100644 --- a/lib/stdio.in.h +++ b/lib/stdio.in.h @@ -118,6 +118,26 @@ # include #endif +/* MSVC declares 'perror' in , not in . We must include + it before we #define perror rpl_perror. */ +/* But in any case avoid namespace pollution on glibc systems. */ +#if (@GNULIB_PERROR@ || defined GNULIB_POSIXCHECK) \ + && ((defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__) \ + && ! defined __GLIBC__ +# include +#endif + +/* MSVC declares 'remove' in , not in . We must include + it before we #define remove rpl_remove. */ +/* MSVC declares 'rename' in , not in . We must include + it before we #define rename rpl_rename. */ +/* But in any case avoid namespace pollution on glibc systems. */ +#if (@GNULIB_REMOVE@ || @GNULIB_RENAME@ || defined GNULIB_POSIXCHECK) \ + && ((defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__) \ + && ! defined __GLIBC__ +# include +#endif + /* The definitions of _GL_FUNCDECL_RPL etc. are copied here. */ diff --git a/lib/stdlib.in.h b/lib/stdlib.in.h index 55602fae0d..b5cf9d3695 100644 --- a/lib/stdlib.in.h +++ b/lib/stdlib.in.h @@ -1,7 +1,6 @@ /* A GNU-like . - Copyright (C) 1995, 2001-2004, 2006-2017 Free Software Foundation, - Inc. + Copyright (C) 1995, 2001-2004, 2006-2017 Free Software Foundation, Inc. This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by diff --git a/lib/strftime.c b/lib/strftime.c index 2e010830f7..9aabcc6748 100644 --- a/lib/strftime.c +++ b/lib/strftime.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1991-2016 Free Software Foundation, Inc. +/* Copyright (C) 1991-2017 Free Software Foundation, Inc. This file is part of the GNU C Library. The GNU C Library is free software; you can redistribute it and/or diff --git a/lib/strtoimax.c b/lib/strtoimax.c index a4faa186c7..3f31fe913a 100644 --- a/lib/strtoimax.c +++ b/lib/strtoimax.c @@ -1,7 +1,7 @@ /* Convert string representation of a number into an intmax_t value. - Copyright (C) 1999, 2001-2004, 2006, 2009-2017 Free Software - Foundation, Inc. + Copyright (C) 1999, 2001-2004, 2006, 2009-2017 Free Software Foundation, + Inc. This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by diff --git a/lib/strtol.c b/lib/strtol.c index 473a5fb90d..751d1e0f1e 100644 --- a/lib/strtol.c +++ b/lib/strtol.c @@ -1,7 +1,7 @@ /* Convert string representation of a number into an integer value. - Copyright (C) 1991-1992, 1994-1999, 2003, 2005-2007, 2009-2017 Free - Software Foundation, Inc. + Copyright (C) 1991-1992, 1994-1999, 2003, 2005-2007, 2009-2017 Free Software + Foundation, Inc. NOTE: The canonical source of this file is maintained with the GNU C Library. Bugs can be reported to bug-glibc@gnu.org. diff --git a/lib/strtoll.c b/lib/strtoll.c index 330167f745..d770e81db3 100644 --- a/lib/strtoll.c +++ b/lib/strtoll.c @@ -1,6 +1,6 @@ /* Function to parse a 'long long int' from text. - Copyright (C) 1995-1997, 1999, 2001, 2009-2017 Free Software - Foundation, Inc. + Copyright (C) 1995-1997, 1999, 2001, 2009-2017 Free Software Foundation, + Inc. This file is part of the GNU C Library. This program is free software: you can redistribute it and/or modify diff --git a/lib/strtoull.c b/lib/strtoull.c index 00d487bd6f..51ae3acb03 100644 --- a/lib/strtoull.c +++ b/lib/strtoull.c @@ -1,6 +1,5 @@ /* Function to parse an 'unsigned long long int' from text. - Copyright (C) 1995-1997, 1999, 2009-2017 Free Software Foundation, - Inc. + Copyright (C) 1995-1997, 1999, 2009-2017 Free Software Foundation, Inc. NOTE: The canonical source of this file is maintained with the GNU C Library. Bugs can be reported to bug-glibc@gnu.org. diff --git a/lib/tempname.c b/lib/tempname.c index 83e537a694..2cd90328bd 100644 --- a/lib/tempname.c +++ b/lib/tempname.c @@ -1,7 +1,6 @@ /* tempname.c - generate the name of a temporary file. - Copyright (C) 1991-2003, 2005-2007, 2009-2017 Free Software - Foundation, Inc. + Copyright (C) 1991-2003, 2005-2007, 2009-2017 Free Software Foundation, Inc. This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by diff --git a/lib/time_r.c b/lib/time_r.c index f0f562db01..708a98b324 100644 --- a/lib/time_r.c +++ b/lib/time_r.c @@ -1,7 +1,6 @@ /* Reentrant time functions like localtime_r. - Copyright (C) 2003, 2006-2007, 2010-2017 Free Software Foundation, - Inc. + Copyright (C) 2003, 2006-2007, 2010-2017 Free Software Foundation, Inc. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by diff --git a/lib/timegm.c b/lib/timegm.c index e552594120..957a3b830c 100644 --- a/lib/timegm.c +++ b/lib/timegm.c @@ -1,7 +1,7 @@ /* Convert UTC calendar time to simple time. Like mktime but assumes UTC. - Copyright (C) 1994, 1997, 2003-2004, 2006-2007, 2009-2017 Free - Software Foundation, Inc. This file is part of the GNU C Library. + Copyright (C) 1994, 1997, 2003-2004, 2006-2007, 2009-2017 Free Software + Foundation, Inc. This file is part of the GNU C Library. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by diff --git a/lib/unistd.in.h b/lib/unistd.in.h index 428b408016..d5fa34dbe5 100644 --- a/lib/unistd.in.h +++ b/lib/unistd.in.h @@ -55,9 +55,13 @@ #include /* mingw doesn't define the SEEK_* or *_FILENO macros in . */ +/* MSVC declares 'unlink' in , not in . We must include + it before we #define unlink rpl_unlink. */ /* Cygwin 1.7.1 declares symlinkat in , not in . */ /* But avoid namespace pollution on glibc systems. */ #if (!(defined SEEK_CUR && defined SEEK_END && defined SEEK_SET) \ + || ((@GNULIB_UNLINK@ || defined GNULIB_POSIXCHECK) \ + && ((defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__)) \ || ((@GNULIB_SYMLINKAT@ || defined GNULIB_POSIXCHECK) \ && defined __CYGWIN__)) \ && ! defined __GLIBC__ @@ -776,7 +780,7 @@ _GL_WARN_ON_USE (gethostname, "gethostname is unportable - " ${LOGNAME-$USER} on Unix platforms, $USERNAME on native Windows platforms. */ -# if !@HAVE_GETLOGIN@ +# if !@HAVE_DECL_GETLOGIN@ _GL_FUNCDECL_SYS (getlogin, char *, (void)); # endif _GL_CXXALIAS_SYS (getlogin, char *, (void)); diff --git a/lib/xalloc-oversized.h b/lib/xalloc-oversized.h index e93c5cc146..6b4e68b7c0 100644 --- a/lib/xalloc-oversized.h +++ b/lib/xalloc-oversized.h @@ -1,7 +1,6 @@ /* xalloc-oversized.h -- memory allocation size checking - Copyright (C) 1990-2000, 2003-2004, 2006-2017 Free Software - Foundation, Inc. + Copyright (C) 1990-2000, 2003-2004, 2006-2017 Free Software Foundation, Inc. This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by diff --git a/m4/alloca.m4 b/m4/alloca.m4 index fd8751b526..7f0604cbda 100644 --- a/m4/alloca.m4 +++ b/m4/alloca.m4 @@ -1,6 +1,6 @@ # alloca.m4 serial 14 -dnl Copyright (C) 2002-2004, 2006-2007, 2009-2017 Free Software -dnl Foundation, Inc. +dnl Copyright (C) 2002-2004, 2006-2007, 2009-2017 Free Software Foundation, +dnl Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/dup2.m4 b/m4/dup2.m4 index f327cb021a..bdb9ae2501 100644 --- a/m4/dup2.m4 +++ b/m4/dup2.m4 @@ -1,6 +1,5 @@ #serial 25 -dnl Copyright (C) 2002, 2005, 2007, 2009-2017 Free Software Foundation, -dnl Inc. +dnl Copyright (C) 2002, 2005, 2007, 2009-2017 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/filemode.m4 b/m4/filemode.m4 index d85bf517e4..91602e1808 100644 --- a/m4/filemode.m4 +++ b/m4/filemode.m4 @@ -1,6 +1,5 @@ # filemode.m4 serial 8 -dnl Copyright (C) 2002, 2005-2006, 2009-2017 Free Software Foundation, -dnl Inc. +dnl Copyright (C) 2002, 2005-2006, 2009-2017 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/flexmember.m4 b/m4/flexmember.m4 index 155ae9b812..35580ac27c 100644 --- a/m4/flexmember.m4 +++ b/m4/flexmember.m4 @@ -1,7 +1,7 @@ # serial 4 # Check for flexible array member support. -# Copyright (C) 2006, 2009-2016 Free Software Foundation, Inc. +# Copyright (C) 2006, 2009-2017 Free Software Foundation, Inc. # This file is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, # with or without modifications, as long as this notice is preserved. diff --git a/m4/getgroups.m4 b/m4/getgroups.m4 index 85605c1151..02ce2353ca 100644 --- a/m4/getgroups.m4 +++ b/m4/getgroups.m4 @@ -3,8 +3,7 @@ dnl From Jim Meyering. dnl A wrapper around AC_FUNC_GETGROUPS. -# Copyright (C) 1996-1997, 1999-2004, 2008-2017 Free Software -# Foundation, Inc. +# Copyright (C) 1996-1997, 1999-2004, 2008-2017 Free Software Foundation, Inc. # # This file is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, diff --git a/m4/getloadavg.m4 b/m4/getloadavg.m4 index e5f991ba01..86334cd043 100644 --- a/m4/getloadavg.m4 +++ b/m4/getloadavg.m4 @@ -1,7 +1,7 @@ # Check for getloadavg. -# Copyright (C) 1992-1996, 1999-2000, 2002-2003, 2006, 2008-2017 Free -# Software Foundation, Inc. +# Copyright (C) 1992-1996, 1999-2000, 2002-2003, 2006, 2008-2017 Free Software +# Foundation, Inc. # This file is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, diff --git a/m4/gettime.m4 b/m4/gettime.m4 index cfaa2c0a99..1cdab2780d 100644 --- a/m4/gettime.m4 +++ b/m4/gettime.m4 @@ -1,6 +1,5 @@ # gettime.m4 serial 8 -dnl Copyright (C) 2002, 2004-2006, 2009-2017 Free Software Foundation, -dnl Inc. +dnl Copyright (C) 2002, 2004-2006, 2009-2017 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/gettimeofday.m4 b/m4/gettimeofday.m4 index 21579d78dc..4f501e5bf9 100644 --- a/m4/gettimeofday.m4 +++ b/m4/gettimeofday.m4 @@ -1,7 +1,6 @@ # serial 21 -# Copyright (C) 2001-2003, 2005, 2007, 2009-2017 Free Software -# Foundation, Inc. +# Copyright (C) 2001-2003, 2005, 2007, 2009-2017 Free Software Foundation, Inc. # This file is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, # with or without modifications, as long as this notice is preserved. diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4 index 1df5bd1738..14af9fbd6b 100644 --- a/m4/gnulib-comp.m4 +++ b/m4/gnulib-comp.m4 @@ -265,7 +265,6 @@ AC_DEFUN([gl_INIT], GNULIB_GL_UNISTD_H_GETOPT=1 fi AC_SUBST([GNULIB_GL_UNISTD_H_GETOPT]) - gl_MODULE_INDICATOR_FOR_TESTS([getopt-gnu]) gl_FUNC_GETOPT_POSIX if test $REPLACE_GETOPT = 1; then AC_LIBOBJ([getopt]) @@ -1099,4 +1098,5 @@ AC_DEFUN([gl_FILE_LIST], [ m4/warn-on-use.m4 m4/warnings.m4 m4/wchar_t.m4 + m4/wint_t.m4 ]) diff --git a/m4/group-member.m4 b/m4/group-member.m4 index f4415dd9de..a68538d24d 100644 --- a/m4/group-member.m4 +++ b/m4/group-member.m4 @@ -1,7 +1,6 @@ # serial 14 -# Copyright (C) 1999-2001, 2003-2007, 2009-2017 Free Software -# Foundation, Inc. +# Copyright (C) 1999-2001, 2003-2007, 2009-2017 Free Software Foundation, Inc. # This file is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, diff --git a/m4/limits-h.m4 b/m4/limits-h.m4 index 31fdf0a779..443f91b4dc 100644 --- a/m4/limits-h.m4 +++ b/m4/limits-h.m4 @@ -1,6 +1,6 @@ dnl Check whether limits.h has needed features. -dnl Copyright 2016 Free Software Foundation, Inc. +dnl Copyright 2016-2017 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/manywarnings.m4 b/m4/manywarnings.m4 index 4f701f4eac..0f06adecfb 100644 --- a/m4/manywarnings.m4 +++ b/m4/manywarnings.m4 @@ -1,5 +1,5 @@ # manywarnings.m4 serial 8 -dnl Copyright (C) 2008-2016 Free Software Foundation, Inc. +dnl Copyright (C) 2008-2017 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/memrchr.m4 b/m4/memrchr.m4 index f8ca164629..e180f6105f 100644 --- a/m4/memrchr.m4 +++ b/m4/memrchr.m4 @@ -1,6 +1,6 @@ # memrchr.m4 serial 10 -dnl Copyright (C) 2002-2003, 2005-2007, 2009-2017 Free Software -dnl Foundation, Inc. +dnl Copyright (C) 2002-2003, 2005-2007, 2009-2017 Free Software Foundation, +dnl Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/mktime.m4 b/m4/mktime.m4 index 23cad732ff..d594ddc58b 100644 --- a/m4/mktime.m4 +++ b/m4/mktime.m4 @@ -1,5 +1,5 @@ # serial 27 -dnl Copyright (C) 2002-2003, 2005-2007, 2009-2016 Free Software Foundation, +dnl Copyright (C) 2002-2003, 2005-2007, 2009-2017 Free Software Foundation, dnl Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, diff --git a/m4/pathmax.m4 b/m4/pathmax.m4 index af51f03f4e..c6c9f24d06 100644 --- a/m4/pathmax.m4 +++ b/m4/pathmax.m4 @@ -1,6 +1,6 @@ # pathmax.m4 serial 10 -dnl Copyright (C) 2002-2003, 2005-2006, 2009-2017 Free Software -dnl Foundation, Inc. +dnl Copyright (C) 2002-2003, 2005-2006, 2009-2017 Free Software Foundation, +dnl Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/sig2str.m4 b/m4/sig2str.m4 index 23b42933a5..c8b8996417 100644 --- a/m4/sig2str.m4 +++ b/m4/sig2str.m4 @@ -1,6 +1,5 @@ # serial 7 -dnl Copyright (C) 2002, 2005-2006, 2009-2017 Free Software Foundation, -dnl Inc. +dnl Copyright (C) 2002, 2005-2006, 2009-2017 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/ssize_t.m4 b/m4/ssize_t.m4 index b262b222a2..66ba9d4ea2 100644 --- a/m4/ssize_t.m4 +++ b/m4/ssize_t.m4 @@ -1,6 +1,5 @@ # ssize_t.m4 serial 5 (gettext-0.18.2) -dnl Copyright (C) 2001-2003, 2006, 2010-2017 Free Software Foundation, -dnl Inc. +dnl Copyright (C) 2001-2003, 2006, 2010-2017 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/st_dm_mode.m4 b/m4/st_dm_mode.m4 index af6757e8a3..ed2cff8c2c 100644 --- a/m4/st_dm_mode.m4 +++ b/m4/st_dm_mode.m4 @@ -1,7 +1,6 @@ # serial 6 -# Copyright (C) 1998-1999, 2001, 2009-2017 Free Software Foundation, -# Inc. +# Copyright (C) 1998-1999, 2001, 2009-2017 Free Software Foundation, Inc. # This file is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, # with or without modifications, as long as this notice is preserved. diff --git a/m4/stat-time.m4 b/m4/stat-time.m4 index af747c6772..4017fc9d7f 100644 --- a/m4/stat-time.m4 +++ b/m4/stat-time.m4 @@ -1,7 +1,7 @@ # Checks for stat-related time functions. -# Copyright (C) 1998-1999, 2001, 2003, 2005-2007, 2009-2017 Free -# Software Foundation, Inc. +# Copyright (C) 1998-1999, 2001, 2003, 2005-2007, 2009-2017 Free Software +# Foundation, Inc. # This file is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, diff --git a/m4/std-gnu11.m4 b/m4/std-gnu11.m4 index 10da26f130..9dae9b1ccf 100644 --- a/m4/std-gnu11.m4 +++ b/m4/std-gnu11.m4 @@ -7,7 +7,7 @@ # or later is installed everywhere a Gnulib program might be developed. -# Copyright (C) 2001-2016 Free Software Foundation, Inc. +# Copyright (C) 2001-2017 Free Software Foundation, Inc. # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by diff --git a/m4/stdint.m4 b/m4/stdint.m4 index 05b6ab7846..4ac854d519 100644 --- a/m4/stdint.m4 +++ b/m4/stdint.m4 @@ -1,5 +1,5 @@ -# stdint.m4 serial 48 -dnl Copyright (C) 2001-2016 Free Software Foundation, Inc. +# stdint.m4 serial 50 +dnl Copyright (C) 2001-2017 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. @@ -12,6 +12,7 @@ AC_DEFUN_ONCE([gl_STDINT_H], AC_PREREQ([2.59])dnl AC_REQUIRE([gl_LIMITS_H]) + AC_REQUIRE([gt_TYPE_WINT_T]) dnl Check for long long int and unsigned long long int. AC_REQUIRE([AC_TYPE_LONG_LONG_INT]) @@ -354,7 +355,7 @@ int32_t i32 = INT32_C (0x7fffffff); gl_STDINT_TYPE_PROPERTIES fi - # The substitute stdint.h needs the substitute limit.h's _GL_INTEGER_WIDTH. + dnl The substitute stdint.h needs the substitute limit.h's _GL_INTEGER_WIDTH. LIMITS_H=limits.h AM_CONDITIONAL([GL_GENERATE_LIMITS_H], [test -n "$LIMITS_H"]) @@ -528,7 +529,7 @@ AC_DEFUN([gl_STDINT_TYPE_PROPERTIES], dnl requirement that wint_t is "unchanged by default argument promotions". dnl In this case gnulib's and override wint_t. dnl Set the variable BITSIZEOF_WINT_T accordingly. - if test $BITSIZEOF_WINT_T -lt 32; then + if test $GNULIB_OVERRIDES_WINT_T = 1; then BITSIZEOF_WINT_T=32 fi ]) diff --git a/m4/stdio_h.m4 b/m4/stdio_h.m4 index eaa25a01d4..9ffbb852ea 100644 --- a/m4/stdio_h.m4 +++ b/m4/stdio_h.m4 @@ -1,5 +1,5 @@ # stdio_h.m4 serial 48 -dnl Copyright (C) 2007-2016 Free Software Foundation, Inc. +dnl Copyright (C) 2007-2017 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/stdlib_h.m4 b/m4/stdlib_h.m4 index 3999068153..110fe2d1a9 100644 --- a/m4/stdlib_h.m4 +++ b/m4/stdlib_h.m4 @@ -1,5 +1,5 @@ # stdlib_h.m4 serial 43 -dnl Copyright (C) 2007-2016 Free Software Foundation, Inc. +dnl Copyright (C) 2007-2017 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/strftime.m4 b/m4/strftime.m4 index b708b1b7dc..3a5db9b4e3 100644 --- a/m4/strftime.m4 +++ b/m4/strftime.m4 @@ -1,7 +1,6 @@ # serial 33 -# Copyright (C) 1996-1997, 1999-2007, 2009-2017 Free Software -# Foundation, Inc. +# Copyright (C) 1996-1997, 1999-2007, 2009-2017 Free Software Foundation, Inc. # # This file is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, diff --git a/m4/strtoimax.m4 b/m4/strtoimax.m4 index 4e98e6690d..f0586f1a80 100644 --- a/m4/strtoimax.m4 +++ b/m4/strtoimax.m4 @@ -1,6 +1,5 @@ # strtoimax.m4 serial 14 -dnl Copyright (C) 2002-2004, 2006, 2009-2017 Free Software Foundation, -dnl Inc. +dnl Copyright (C) 2002-2004, 2006, 2009-2017 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/strtoll.m4 b/m4/strtoll.m4 index 3570f38170..9c2a903428 100644 --- a/m4/strtoll.m4 +++ b/m4/strtoll.m4 @@ -1,6 +1,5 @@ # strtoll.m4 serial 7 -dnl Copyright (C) 2002, 2004, 2006, 2008-2017 Free Software Foundation, -dnl Inc. +dnl Copyright (C) 2002, 2004, 2006, 2008-2017 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/strtoull.m4 b/m4/strtoull.m4 index bc9b7ca8eb..c6b215072b 100644 --- a/m4/strtoull.m4 +++ b/m4/strtoull.m4 @@ -1,6 +1,5 @@ # strtoull.m4 serial 7 -dnl Copyright (C) 2002, 2004, 2006, 2008-2017 Free Software Foundation, -dnl Inc. +dnl Copyright (C) 2002, 2004, 2006, 2008-2017 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/strtoumax.m4 b/m4/strtoumax.m4 index 5b690d5500..43ef5b5abb 100644 --- a/m4/strtoumax.m4 +++ b/m4/strtoumax.m4 @@ -1,6 +1,5 @@ # strtoumax.m4 serial 12 -dnl Copyright (C) 2002-2004, 2006, 2009-2017 Free Software Foundation, -dnl Inc. +dnl Copyright (C) 2002-2004, 2006, 2009-2017 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/sys_types_h.m4 b/m4/sys_types_h.m4 index 159b005b3d..2eb4e9e44e 100644 --- a/m4/sys_types_h.m4 +++ b/m4/sys_types_h.m4 @@ -1,5 +1,5 @@ # sys_types_h.m4 serial 6 -dnl Copyright (C) 2011-2016 Free Software Foundation, Inc. +dnl Copyright (C) 2011-2017 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/time_h.m4 b/m4/time_h.m4 index bdc1499b2e..b92567875c 100644 --- a/m4/time_h.m4 +++ b/m4/time_h.m4 @@ -1,7 +1,6 @@ # Configure a more-standard replacement for . -# Copyright (C) 2000-2001, 2003-2007, 2009-2017 Free Software -# Foundation, Inc. +# Copyright (C) 2000-2001, 2003-2007, 2009-2017 Free Software Foundation, Inc. # serial 9 diff --git a/m4/timespec.m4 b/m4/timespec.m4 index 6c9aa08a4b..c901468ed8 100644 --- a/m4/timespec.m4 +++ b/m4/timespec.m4 @@ -1,7 +1,6 @@ #serial 15 -# Copyright (C) 2000-2001, 2003-2007, 2009-2017 Free Software -# Foundation, Inc. +# Copyright (C) 2000-2001, 2003-2007, 2009-2017 Free Software Foundation, Inc. # This file is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, diff --git a/m4/unistd_h.m4 b/m4/unistd_h.m4 index 1a50760548..25aef19ec9 100644 --- a/m4/unistd_h.m4 +++ b/m4/unistd_h.m4 @@ -1,4 +1,4 @@ -# unistd_h.m4 serial 68 +# unistd_h.m4 serial 69 dnl Copyright (C) 2006-2017 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -145,6 +145,7 @@ AC_DEFUN([gl_UNISTD_H_DEFAULTS], HAVE_DECL_FCHDIR=1; AC_SUBST([HAVE_DECL_FCHDIR]) HAVE_DECL_FDATASYNC=1; AC_SUBST([HAVE_DECL_FDATASYNC]) HAVE_DECL_GETDOMAINNAME=1; AC_SUBST([HAVE_DECL_GETDOMAINNAME]) + HAVE_DECL_GETLOGIN=1; AC_SUBST([HAVE_DECL_GETLOGIN]) HAVE_DECL_GETLOGIN_R=1; AC_SUBST([HAVE_DECL_GETLOGIN_R]) HAVE_DECL_GETPAGESIZE=1; AC_SUBST([HAVE_DECL_GETPAGESIZE]) HAVE_DECL_GETUSERSHELL=1; AC_SUBST([HAVE_DECL_GETUSERSHELL]) diff --git a/m4/utimbuf.m4 b/m4/utimbuf.m4 index f11d5da706..1c42234959 100644 --- a/m4/utimbuf.m4 +++ b/m4/utimbuf.m4 @@ -1,7 +1,7 @@ # serial 9 -# Copyright (C) 1998-2001, 2003-2004, 2007, 2009-2017 Free Software -# Foundation, Inc. +# Copyright (C) 1998-2001, 2003-2004, 2007, 2009-2017 Free Software Foundation, +# Inc. # # This file is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, commit bcf244ef9be0fe61f4b9a48d3412b2c8a9f1edb9 Merge: 772ca5db3e 2e2a806803 Author: Paul Eggert Date: Sun Jan 1 01:10:47 2017 -0800 Merge from origin/emacs-25 2e2a806 Fix copyright years by hand 5badc81 Update copyright year to 2017 commit 772ca5db3eccdc0439d7bd18f98b7fdd38eb6397 Merge: 0a89d04cf7 e092f08515 Author: Paul Eggert Date: Sun Jan 1 01:05:03 2017 -0800 ; Merge from origin/emacs-25 The following commit was skipped: e092f08 Bump Emacs version to 25.1.91 commit 0a89d04cf78de9c7c6942cc48b79b67e6f05a68c Merge: 88b65c6357 665be694b6 Author: Paul Eggert Date: Sun Jan 1 01:05:02 2017 -0800 Merge from origin/emacs-25 665be69 ; Update ChangeLog.2 and AUTHORS files # Conflicts: # etc/AUTHORS commit 88b65c6357f91b9080ab4b8ca398ddd6203c3247 Merge: 61848d2da3 e8f0d7dcad Author: Paul Eggert Date: Sun Jan 1 01:02:48 2017 -0800 ; Merge from origin/emacs-25 The following commits were skipped: e8f0d7d Backport: Remove an ambiguity from defvar's doc string. Fixe... af1b102 * lisp/emacs-lisp/inline.el: Fix apply-conversion (bug#25280) commit 61848d2da32bb889d714fcddcb7dfd6dfa1b502d Merge: bbb683f04a 697167b543 Author: Paul Eggert Date: Sun Jan 1 01:02:47 2017 -0800 Merge from origin/emacs-25 697167b ; Improve wording of previous change in variables.texi d7973e8 Document 'default-toplevel-value' and 'set-default-toplevel-v... 8b71826 Don't modify minibuffer variables globally 5b5e036 Revert to pre-25.1 behavior in ffap 19994a1 * lisp/ffap.el: Fix obsolete comment referencing ffap-bug. 3ace730 Attempt to fix 64-bit AIX build f69bd79 Clarify usage of 'ediff-cleanup-hook' (Bug#24675) c04ac8a Document that variable binding order is unspecified 272554a * lisp/desktop.el (desktop-buffers-not-to-save): Doc fix. 08de101 Fix M-x hints on Mac port 86a297a Work around reporting a dpi change in apply_xft_settings cf1f985 ; lisp/skeleton.el (skeleton-insert): Fix typo in last change 9e1209d Amend the version number of CC Mode 5.33 -> 5.32.99. Don't m... 88cdf14 Improve skeleton docstrings commit bbb683f04aa0960422b12af5ef79679344fac19c Merge: 9bec2fb3c1 ce5538248e Author: Paul Eggert Date: Sun Jan 1 01:02:47 2017 -0800 ; Merge from origin/emacs-25 The following commit was skipped: ce55382 ; Auto-commit of loaddefs file. commit 9bec2fb3c19968a673f761c55057c4dbc9d907be Merge: 37b01efe20 4179238fa8 Author: Paul Eggert Date: Sun Jan 1 01:02:46 2017 -0800 Merge from origin/emacs-25 4179238 Improve documentation of 'w32-scroll-lock-modifier' commit 37b01efe2041999963db839ddf5dc94698e1da61 Merge: 4f7a90bf6c dfc9f114c7 Author: Paul Eggert Date: Sun Jan 1 01:02:46 2017 -0800 ; Merge from origin/emacs-25 The following commit was skipped: dfc9f11 Merge branch 'emacs-25' of git.savannah.gnu.org:/srv/git/emac... commit 4f7a90bf6ce831063d721324e712f8c38e85c678 Merge: 620e5a3cd4 9adb101353 Author: Paul Eggert Date: Sun Jan 1 01:02:45 2017 -0800 Merge from origin/emacs-25 9adb101 Document 'describe-fontset' 229315c ; Add missing symbol quoting. 3d94931 Repair desktop restoration on text terminals 43022f9 Ignore forward-sexp-function in js-mode indentation code b19fb49 Improve documentation of 'define-coding-system' 467768f Fix Bug#25162 6db78ae Fix a typo in define-abbrev-table 5f7d906 Bump makeinfo requirement from 4.7 to 4.13 442e2f6 Fixes related to select-enable-clipboard e4ac450 Define struct predicate before acccesors 08decbd Doc fix for vc-git 5531e75 Further improve make-dist checking 953bf67 Improve previous make-dist change 129645a Make make-dist --snapshot do some sanity checks # Conflicts: # lisp/menu-bar.el commit 620e5a3cd4464aaffaa3568d6f6b89764de5cfbd Author: Alan Mackenzie Date: Sun Jan 1 08:28:04 2017 +0000 Give eval-and-compile a correct edebug spec. Fixes bug #16184 properly. * lisp/emacs-lisp/edebug.el (edebug_offset_indices): Revert abortive commit from Thu Dec 29 09:22:36 2016 +0000 which didn't really fix the bug. * lisp/emacs-lisp/byte-run.el (eval-and-compile): Change the edebug spec from t to (&rest def-form). diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index 9d2a048f36..e680ebbdc5 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -474,7 +474,7 @@ load time. In interpreted code, this is entirely equivalent to `progn', except that the value of the expression may be (but is not necessarily) computed at load time if eager macro expansion is enabled." - (declare (debug t) (indent 0)) + (declare (debug (&rest def-form)) (indent 0)) ;; When the byte-compiler expands code, this macro is not used, so we're ;; either about to run `body' (plain interpretation) or we're doing eager ;; macroexpansion. diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 15b1389c2f..04a493c826 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -2052,14 +2052,11 @@ expressions; a `progn' form will be returned enclosing these forms." (defvar edebug-stack-depth -1) ;; Index of last edebug-stack item. -(defvar edebug-offset-indices (list 0)) +(defvar edebug-offset-indices nil) ;; Stack of offset indices of visited edebug sexps. +;; Should be nil at the top level. ;; Each function adds one cons. Top is modified with setcar. -;; Should be nil at the top level. No longer! There are occasions -;; when this variable is modified by setcar before a cons has been -;; pushed by `edebug-enter', e.g. when instrumenting -;; `c-font-lock-declarations' in .../lisp/progmodes/cc-fonts.el. So -;; this variable must be initialized to a cons. + (defvar edebug-entered nil ;; Non-nil if edebug has already been entered at this recursive edit level. commit 2e2a8068031b79a6cc5502b8d4c9d849ebb1dae0 Author: Paul Eggert Date: Sun Jan 1 04:01:41 2017 +0000 Fix copyright years by hand These are dates that admin/update-copyright did not update, or updated incorrectly. diff --git a/config.bat b/config.bat index a5bea7135a..d1f2702d35 100644 --- a/config.bat +++ b/config.bat @@ -1,7 +1,7 @@ @echo off rem ---------------------------------------------------------------------- rem Configuration script for MSDOS -rem Copyright (C) 1994-1999, 2001-2016 Free Software Foundation, Inc. +rem Copyright (C) 1994-1999, 2001-2017 Free Software Foundation, Inc. rem This file is part of GNU Emacs. diff --git a/configure.ac b/configure.ac index 4d9ed93a44..4e80eed272 100644 --- a/configure.ac +++ b/configure.ac @@ -4847,7 +4847,7 @@ fi version=$PACKAGE_VERSION -copyright="Copyright (C) 2016 Free Software Foundation, Inc." +copyright="Copyright (C) 2017 Free Software Foundation, Inc." AC_DEFINE_UNQUOTED(COPYRIGHT, ["$copyright"], [Short copyright string for this version of Emacs.]) AC_SUBST(copyright) @@ -5200,7 +5200,7 @@ AC_SUBST(WINDOW_SYSTEM_OBJ) AH_TOP([/* GNU Emacs site configuration template file. -Copyright (C) 1988, 1993-1994, 1999-2002, 2004-2016 +Copyright (C) 1988, 1993-1994, 1999-2002, 2004-2017 Free Software Foundation, Inc. This file is part of GNU Emacs. diff --git a/doc/emacs/emacs-xtra.texi b/doc/emacs/emacs-xtra.texi index 786ba6584b..d4d4860f95 100644 --- a/doc/emacs/emacs-xtra.texi +++ b/doc/emacs/emacs-xtra.texi @@ -12,7 +12,7 @@ @copying This manual describes specialized features of Emacs. -Copyright @copyright{} 2004--2016 Free Software Foundation, Inc. +Copyright @copyright{} 2004--2017 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document diff --git a/doc/emacs/emacs.texi b/doc/emacs/emacs.texi index c23c96f074..a6f2896231 100644 --- a/doc/emacs/emacs.texi +++ b/doc/emacs/emacs.texi @@ -27,7 +27,7 @@ This is the @cite{GNU Emacs Manual}, @end ifnottex updated for Emacs version @value{EMACSVER}. -Copyright @copyright{} 1985--1987, 1993--2016 Free Software Foundation, Inc. +Copyright @copyright{} 1985--1987, 1993--2017 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document diff --git a/doc/lispintro/emacs-lisp-intro.texi b/doc/lispintro/emacs-lisp-intro.texi index 86c8da0e46..5505334fd1 100644 --- a/doc/lispintro/emacs-lisp-intro.texi +++ b/doc/lispintro/emacs-lisp-intro.texi @@ -113,7 +113,7 @@ Edition @value{edition-number}, @value{update-date} Distributed with Emacs version @value{EMACSVER}. @end ifnottex @sp 1 -Copyright @copyright{} 1990--1995, 1997, 2001--2016 Free Software +Copyright @copyright{} 1990--1995, 1997, 2001--2017 Free Software Foundation, Inc. @sp 1 diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi index 3297e5308a..737479ce09 100644 --- a/doc/lispref/elisp.texi +++ b/doc/lispref/elisp.texi @@ -99,7 +99,7 @@ This is the @cite{GNU Emacs Lisp Reference Manual} @end ifnottex corresponding to Emacs version @value{EMACSVER}. -Copyright @copyright{} 1990--1996, 1998--2016 Free Software Foundation, Inc. +Copyright @copyright{} 1990--1996, 1998--2017 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document diff --git a/doc/lispref/tips.texi b/doc/lispref/tips.texi index ad8ac34a9c..bd560370f7 100644 --- a/doc/lispref/tips.texi +++ b/doc/lispref/tips.texi @@ -931,7 +931,7 @@ explains these conventions, starting with an example: @group ;;; foo.el --- Support for the Foo programming language -;; Copyright (C) 2010-2016 Your Name +;; Copyright (C) 2010-2017 Your Name @end group ;; Author: Your Name diff --git a/doc/man/ebrowse.1 b/doc/man/ebrowse.1 index efbb95b2f7..ad347d13a2 100644 --- a/doc/man/ebrowse.1 +++ b/doc/man/ebrowse.1 @@ -85,7 +85,7 @@ was written by Gerd Moellmann. Copyright .if t \(co .if n (C) -2008-2016 Free Software Foundation, Inc. +2008-2017 Free Software Foundation, Inc. .PP Permission is granted to make and distribute verbatim copies of this document provided the copyright notice and this permission notice are diff --git a/doc/man/emacs.1.in b/doc/man/emacs.1.in index 3b1566f6ca..5f1976a3c3 100644 --- a/doc/man/emacs.1.in +++ b/doc/man/emacs.1.in @@ -651,7 +651,7 @@ For detailed credits and acknowledgments, see the GNU Emacs manual. Copyright .if t \(co .if n (C) -1995, 1999-2016 Free Software Foundation, Inc. +1995, 1999-2017 Free Software Foundation, Inc. .PP Permission is granted to make and distribute verbatim copies of this document provided the copyright notice and this permission notice are diff --git a/doc/man/etags.1 b/doc/man/etags.1 index 83b970f906..ee3971cb76 100644 --- a/doc/man/etags.1 +++ b/doc/man/etags.1 @@ -284,7 +284,7 @@ Stallman. Copyright .if t \(co .if n (C) -1992, 1999, 2001-2016 Free Software Foundation, Inc. +1992, 1999, 2001-2017 Free Software Foundation, Inc. .PP Permission is granted to make and distribute verbatim copies of this document provided the copyright notice and this permission notice are diff --git a/doc/misc/ada-mode.texi b/doc/misc/ada-mode.texi index 4fc0c053db..127a009417 100644 --- a/doc/misc/ada-mode.texi +++ b/doc/misc/ada-mode.texi @@ -4,7 +4,7 @@ @include docstyle.texi @copying -Copyright @copyright{} 1999--2016 Free Software Foundation, Inc. +Copyright @copyright{} 1999--2017 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document diff --git a/doc/misc/auth.texi b/doc/misc/auth.texi index fa4be248f3..29e55eda52 100644 --- a/doc/misc/auth.texi +++ b/doc/misc/auth.texi @@ -11,7 +11,7 @@ @copying This file describes the Emacs auth-source library. -Copyright @copyright{} 2008--2016 Free Software Foundation, Inc. +Copyright @copyright{} 2008--2017 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document diff --git a/doc/misc/autotype.texi b/doc/misc/autotype.texi index 6bdbd344c7..507a048da5 100644 --- a/doc/misc/autotype.texi +++ b/doc/misc/autotype.texi @@ -11,7 +11,7 @@ @c @cindex autotypist @copying -Copyright @copyright{} 1994--1995, 1999, 2001--2016 +Copyright @copyright{} 1994--1995, 1999, 2001--2017 Free Software Foundation, Inc. @quotation diff --git a/doc/misc/bovine.texi b/doc/misc/bovine.texi index 11dbfffcec..dadf903b36 100644 --- a/doc/misc/bovine.texi +++ b/doc/misc/bovine.texi @@ -24,7 +24,7 @@ @c %**end of header @copying -Copyright @copyright{} 1999--2004, 2012--2016 Free Software Foundation, Inc. +Copyright @copyright{} 1999--2004, 2012--2017 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document diff --git a/doc/misc/calc.texi b/doc/misc/calc.texi index b4c69ba190..baf46f7170 100644 --- a/doc/misc/calc.texi +++ b/doc/misc/calc.texi @@ -95,7 +95,7 @@ This file documents Calc, the GNU Emacs calculator, included with GNU Emacs @value{EMACSVER}. @end ifnotinfo -Copyright @copyright{} 1990--1991, 2001--2016 Free Software Foundation, Inc. +Copyright @copyright{} 1990--1991, 2001--2017 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document diff --git a/doc/misc/cc-mode.texi b/doc/misc/cc-mode.texi index 2d95fb824f..6a58d4fcab 100644 --- a/doc/misc/cc-mode.texi +++ b/doc/misc/cc-mode.texi @@ -157,7 +157,7 @@ CC Mode @copying This manual is for CC Mode in Emacs. -Copyright @copyright{} 1995--2016 Free Software Foundation, Inc. +Copyright @copyright{} 1995--2017 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document diff --git a/doc/misc/cl.texi b/doc/misc/cl.texi index 75a83602fa..c30381a475 100644 --- a/doc/misc/cl.texi +++ b/doc/misc/cl.texi @@ -7,7 +7,7 @@ @copying This file documents the GNU Emacs Common Lisp emulation package. -Copyright @copyright{} 1993, 2001--2016 Free Software Foundation, Inc. +Copyright @copyright{} 1993, 2001--2017 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document diff --git a/doc/misc/dbus.texi b/doc/misc/dbus.texi index f4ebfebcbe..a2494d3920 100644 --- a/doc/misc/dbus.texi +++ b/doc/misc/dbus.texi @@ -10,7 +10,7 @@ @syncodeindex fn cp @copying -Copyright @copyright{} 2007--2016 Free Software Foundation, Inc. +Copyright @copyright{} 2007--2017 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document diff --git a/doc/misc/dired-x.texi b/doc/misc/dired-x.texi index 474dd0a520..60113b3a81 100644 --- a/doc/misc/dired-x.texi +++ b/doc/misc/dired-x.texi @@ -20,7 +20,7 @@ @comment %**end of header (This is for running Texinfo on a region.) @copying -Copyright @copyright{} 1994--1995, 1999, 2001--2016 +Copyright @copyright{} 1994--1995, 1999, 2001--2017 Free Software Foundation, Inc. @quotation diff --git a/doc/misc/ebrowse.texi b/doc/misc/ebrowse.texi index 816cb56255..61ee04e2b5 100644 --- a/doc/misc/ebrowse.texi +++ b/doc/misc/ebrowse.texi @@ -11,7 +11,7 @@ @copying This file documents Ebrowse, a C++ class browser for GNU Emacs. -Copyright @copyright{} 2000--2016 Free Software Foundation, Inc. +Copyright @copyright{} 2000--2017 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document diff --git a/doc/misc/ede.texi b/doc/misc/ede.texi index 839b5acd49..e87ae95f62 100644 --- a/doc/misc/ede.texi +++ b/doc/misc/ede.texi @@ -6,7 +6,7 @@ @copying This file describes EDE, the Emacs Development Environment. -Copyright @copyright{} 1998--2001, 2004--2005, 2008--2016 +Copyright @copyright{} 1998--2001, 2004--2005, 2008--2017 Free Software Foundation, Inc. @quotation diff --git a/doc/misc/ediff.texi b/doc/misc/ediff.texi index 896a6041e8..19b7adbd66 100644 --- a/doc/misc/ediff.texi +++ b/doc/misc/ediff.texi @@ -26,7 +26,7 @@ This file documents Ediff, a comprehensive visual interface to Unix diff and patch utilities. -Copyright @copyright{} 1995--2016 Free Software Foundation, Inc. +Copyright @copyright{} 1995--2017 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document diff --git a/doc/misc/edt.texi b/doc/misc/edt.texi index cb22b82e26..9680aa4b0b 100644 --- a/doc/misc/edt.texi +++ b/doc/misc/edt.texi @@ -6,7 +6,7 @@ @copying This file documents the EDT emulation package for Emacs. -Copyright @copyright{} 1986, 1992, 1994--1995, 1999--2016 +Copyright @copyright{} 1986, 1992, 1994--1995, 1999--2017 Free Software Foundation, Inc. @quotation diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi index 9efe0e73c5..f7a47f8675 100644 --- a/doc/misc/efaq.texi +++ b/doc/misc/efaq.texi @@ -12,7 +12,7 @@ @c appreciate a notice if you do). @copying -Copyright @copyright{} 2001--2016 Free Software Foundation, Inc.@* +Copyright @copyright{} 2001--2017 Free Software Foundation, Inc.@* Copyright @copyright{} 1994, 1995, 1996, 1997, 1998, 1999, 2000 Reuven M. Lerner@* Copyright @copyright{} 1992, 1993 Steven Byrnes@* diff --git a/doc/misc/eieio.texi b/doc/misc/eieio.texi index 31930020e3..3820bd50df 100644 --- a/doc/misc/eieio.texi +++ b/doc/misc/eieio.texi @@ -12,7 +12,7 @@ @copying This manual documents EIEIO, an object framework for Emacs Lisp. -Copyright @copyright{} 2007--2016 Free Software Foundation, Inc. +Copyright @copyright{} 2007--2017 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document diff --git a/doc/misc/emacs-gnutls.texi b/doc/misc/emacs-gnutls.texi index 1a850c6823..f47a361f04 100644 --- a/doc/misc/emacs-gnutls.texi +++ b/doc/misc/emacs-gnutls.texi @@ -9,7 +9,7 @@ @copying This file describes the Emacs GnuTLS integration. -Copyright @copyright{} 2012--2016 Free Software Foundation, Inc. +Copyright @copyright{} 2012--2017 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document diff --git a/doc/misc/emacs-mime.texi b/doc/misc/emacs-mime.texi index 4d68246bba..e21b9eea09 100644 --- a/doc/misc/emacs-mime.texi +++ b/doc/misc/emacs-mime.texi @@ -12,7 +12,7 @@ @copying This file documents the Emacs MIME interface functionality. -Copyright @copyright{} 1998--2016 Free Software Foundation, Inc. +Copyright @copyright{} 1998--2017 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document diff --git a/doc/misc/epa.texi b/doc/misc/epa.texi index cb177c41f4..dadd064ba2 100644 --- a/doc/misc/epa.texi +++ b/doc/misc/epa.texi @@ -10,7 +10,7 @@ @copying This file describes EasyPG Assistant @value{VERSION}. -Copyright @copyright{} 2007--2016 Free Software Foundation, Inc. +Copyright @copyright{} 2007--2017 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi index d9b646f737..e38ead079a 100644 --- a/doc/misc/erc.texi +++ b/doc/misc/erc.texi @@ -10,7 +10,7 @@ @copying This manual is for ERC as distributed with Emacs @value{EMACSVER}. -Copyright @copyright{} 2005--2016 Free Software Foundation, Inc. +Copyright @copyright{} 2005--2017 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document diff --git a/doc/misc/ert.texi b/doc/misc/ert.texi index 144dfd9371..b07cb0be49 100644 --- a/doc/misc/ert.texi +++ b/doc/misc/ert.texi @@ -11,7 +11,7 @@ @end direntry @copying -Copyright @copyright{} 2008, 2010--2016 Free Software Foundation, Inc. +Copyright @copyright{} 2008, 2010--2017 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi index a7a3840aa5..bd89b9c5bf 100644 --- a/doc/misc/eshell.texi +++ b/doc/misc/eshell.texi @@ -10,7 +10,7 @@ @copying This manual is for Eshell, the Emacs shell. -Copyright @copyright{} 1999--2016 Free Software Foundation, Inc. +Copyright @copyright{} 1999--2017 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document diff --git a/doc/misc/eudc.texi b/doc/misc/eudc.texi index 1bbb108b8b..b7b263d519 100644 --- a/doc/misc/eudc.texi +++ b/doc/misc/eudc.texi @@ -14,7 +14,7 @@ This file documents EUDC version 1.40.0. EUDC is the Emacs Unified Directory Client, a common interface to directory servers and contact information. -Copyright @copyright{} 1998, 2000--2016 Free Software Foundation, Inc. +Copyright @copyright{} 1998, 2000--2017 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document diff --git a/doc/misc/eww.texi b/doc/misc/eww.texi index 7726a8d3dc..dd4374751c 100644 --- a/doc/misc/eww.texi +++ b/doc/misc/eww.texi @@ -8,7 +8,7 @@ @copying This file documents the GNU Emacs Web Wowser (EWW) package. -Copyright @copyright{} 2014--2016 Free Software Foundation, Inc. +Copyright @copyright{} 2014--2017 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document diff --git a/doc/misc/flymake.texi b/doc/misc/flymake.texi index 1c4644bba1..fc9af1aec2 100644 --- a/doc/misc/flymake.texi +++ b/doc/misc/flymake.texi @@ -12,7 +12,7 @@ This manual is for GNU Flymake (version @value{VERSION}, @value{UPDATED}), which is a universal on-the-fly syntax checker for GNU Emacs. -Copyright @copyright{} 2004--2016 Free Software Foundation, Inc. +Copyright @copyright{} 2004--2017 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document diff --git a/doc/misc/forms.texi b/doc/misc/forms.texi index 13654ed593..85be178ee0 100644 --- a/doc/misc/forms.texi +++ b/doc/misc/forms.texi @@ -19,7 +19,7 @@ @copying This file documents Forms mode, a form-editing major mode for GNU Emacs. -Copyright @copyright{} 1989, 1997, 2001--2016 Free Software Foundation, Inc. +Copyright @copyright{} 1989, 1997, 2001--2017 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document diff --git a/doc/misc/gnus-coding.texi b/doc/misc/gnus-coding.texi index 661e705b15..542779f22a 100644 --- a/doc/misc/gnus-coding.texi +++ b/doc/misc/gnus-coding.texi @@ -8,7 +8,7 @@ @syncodeindex pg cp @copying -Copyright @copyright{} 2004--2005, 2007--2016 Free Software +Copyright @copyright{} 2004--2005, 2007--2017 Free Software Foundation, Inc. @quotation diff --git a/doc/misc/gnus-news.el b/doc/misc/gnus-news.el index 8a77e38e15..c7d41c8555 100644 --- a/doc/misc/gnus-news.el +++ b/doc/misc/gnus-news.el @@ -26,7 +26,7 @@ (defvar gnus-news-header-disclaimer "GNUS NEWS -- history of user-visible changes. -Copyright (C) 1999-2016 Free Software Foundation, Inc. +Copyright (C) 1999-2017 Free Software Foundation, Inc. See the end of the file for license conditions. Please send Gnus bug reports to bugs@gnus.org. diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 11f9f35227..e32b15ce0a 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -10,7 +10,7 @@ @syncodeindex pg cp @copying -Copyright @copyright{} 1995--2016 Free Software Foundation, Inc. +Copyright @copyright{} 1995--2017 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document diff --git a/doc/misc/idlwave.texi b/doc/misc/idlwave.texi index 32b3364165..b6a8cc8cfb 100644 --- a/doc/misc/idlwave.texi +++ b/doc/misc/idlwave.texi @@ -23,7 +23,7 @@ Emacs, and interacting with an IDL shell run as a subprocess. This is edition @value{EDITION} of the IDLWAVE User Manual for IDLWAVE @value{VERSION}. -Copyright @copyright{} 1999--2016 Free Software Foundation, Inc. +Copyright @copyright{} 1999--2017 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document diff --git a/doc/misc/info.texi b/doc/misc/info.texi index 1b964e6b2c..6f2e53aa73 100644 --- a/doc/misc/info.texi +++ b/doc/misc/info.texi @@ -15,7 +15,7 @@ This file describes how to use Info, the menu-driven GNU documentation system. -Copyright @copyright{} 1989, 1992, 1996--2016 Free Software Foundation, Inc. +Copyright @copyright{} 1989, 1992, 1996--2017 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document diff --git a/doc/misc/mairix-el.texi b/doc/misc/mairix-el.texi index 69d3fc4227..47fa5bcd81 100644 --- a/doc/misc/mairix-el.texi +++ b/doc/misc/mairix-el.texi @@ -5,7 +5,7 @@ @include docstyle.texi @copying -Copyright @copyright{} 2008--2016 Free Software Foundation, Inc. +Copyright @copyright{} 2008--2017 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document diff --git a/doc/misc/message.texi b/doc/misc/message.texi index 0b82f343d7..c8543cc66c 100644 --- a/doc/misc/message.texi +++ b/doc/misc/message.texi @@ -11,7 +11,7 @@ @copying This file documents Message, the Emacs message composition mode. -Copyright @copyright{} 1996--2016 Free Software Foundation, Inc. +Copyright @copyright{} 1996--2017 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document diff --git a/doc/misc/mh-e.texi b/doc/misc/mh-e.texi index 2ff0dac35d..a113272e49 100644 --- a/doc/misc/mh-e.texi +++ b/doc/misc/mh-e.texi @@ -25,7 +25,7 @@ This is version @value{VERSION}@value{EDITION} of @cite{The MH-E Manual}, last updated @value{UPDATED}. -Copyright @copyright{} 1995, 2001--2003, 2005--2016 Free Software +Copyright @copyright{} 1995, 2001--2003, 2005--2017 Free Software Foundation, Inc. @c This dual license has been agreed upon by the FSF. diff --git a/doc/misc/newsticker.texi b/doc/misc/newsticker.texi index f7a76207ed..6928baab1f 100644 --- a/doc/misc/newsticker.texi +++ b/doc/misc/newsticker.texi @@ -15,7 +15,7 @@ This manual documents Newsticker, a feed reader for Emacs. It corresponds to Emacs version @value{EMACSVER}. @noindent -Copyright @copyright{} 2004--2016 Free Software Foundation, Inc. +Copyright @copyright{} 2004--2017 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document diff --git a/doc/misc/nxml-mode.texi b/doc/misc/nxml-mode.texi index 62bd6bde97..c40cfa5634 100644 --- a/doc/misc/nxml-mode.texi +++ b/doc/misc/nxml-mode.texi @@ -9,7 +9,7 @@ This manual documents nXML mode, an Emacs major mode for editing XML with RELAX NG support. -Copyright @copyright{} 2007--2016 Free Software Foundation, Inc. +Copyright @copyright{} 2007--2017 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document diff --git a/doc/misc/octave-mode.texi b/doc/misc/octave-mode.texi index 0307873df0..e7c2ee2193 100644 --- a/doc/misc/octave-mode.texi +++ b/doc/misc/octave-mode.texi @@ -6,7 +6,7 @@ @c %**end of header @copying -Copyright @copyright{} 1996--2016 Free Software Foundation, Inc. +Copyright @copyright{} 1996--2017 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document diff --git a/doc/misc/org.texi b/doc/misc/org.texi index a6f9dbde7c..596300e5ed 100644 --- a/doc/misc/org.texi +++ b/doc/misc/org.texi @@ -259,7 +259,7 @@ @copying This manual is for Org version @value{VERSION}. -Copyright @copyright{} 2004--2016 Free Software Foundation, Inc. +Copyright @copyright{} 2004--2017 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document @@ -12955,7 +12955,7 @@ Copyright information is printed on the back of the title page. This is a short example of a complete Texinfo file, version 1.0. - Copyright \copy 2016 Free Software Foundation, Inc. + Copyright \copy 2017 Free Software Foundation, Inc. @end example @subsubheading The Top node diff --git a/doc/misc/pcl-cvs.texi b/doc/misc/pcl-cvs.texi index 237ba5c520..4cf38bd1f0 100644 --- a/doc/misc/pcl-cvs.texi +++ b/doc/misc/pcl-cvs.texi @@ -7,7 +7,7 @@ @c %**end of header @copying -Copyright @copyright{} 1991--2016 Free Software Foundation, Inc. +Copyright @copyright{} 1991--2017 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document diff --git a/doc/misc/pgg.texi b/doc/misc/pgg.texi index 3b31e4b0e7..950df60e12 100644 --- a/doc/misc/pgg.texi +++ b/doc/misc/pgg.texi @@ -12,7 +12,7 @@ This file describes PGG @value{VERSION}, an Emacs interface to various PGP implementations. -Copyright @copyright{} 2001, 2003--2016 Free Software Foundation, Inc. +Copyright @copyright{} 2001, 2003--2017 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document diff --git a/doc/misc/rcirc.texi b/doc/misc/rcirc.texi index cdead72c63..1b5bdfcc68 100644 --- a/doc/misc/rcirc.texi +++ b/doc/misc/rcirc.texi @@ -6,7 +6,7 @@ @c %**end of header @copying -Copyright @copyright{} 2006--2016 Free Software Foundation, Inc. +Copyright @copyright{} 2006--2017 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document diff --git a/doc/misc/reftex.texi b/doc/misc/reftex.texi index ff7011c5a7..dfe0ecceba 100644 --- a/doc/misc/reftex.texi +++ b/doc/misc/reftex.texi @@ -46,7 +46,7 @@ This manual documents @RefTeX{} (version @value{VERSION}), a package to do labels, references, citations and indices for LaTeX documents with Emacs. -Copyright @copyright{} 1997--2016 Free Software Foundation, Inc. +Copyright @copyright{} 1997--2017 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document diff --git a/doc/misc/remember.texi b/doc/misc/remember.texi index 965962c006..3d90d5f3bf 100644 --- a/doc/misc/remember.texi +++ b/doc/misc/remember.texi @@ -9,7 +9,7 @@ @copying This manual is for Remember Mode, version 2.0 -Copyright @copyright{} 2001, 2004--2005, 2007--2016 +Copyright @copyright{} 2001, 2004--2005, 2007--2017 Free Software Foundation, Inc. @quotation diff --git a/doc/misc/sasl.texi b/doc/misc/sasl.texi index d012e808ca..049bae0067 100644 --- a/doc/misc/sasl.texi +++ b/doc/misc/sasl.texi @@ -11,7 +11,7 @@ @copying This file describes the Emacs SASL library, version @value{VERSION}. -Copyright @copyright{} 2000, 2004--2016 Free Software Foundation, Inc. +Copyright @copyright{} 2000, 2004--2017 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document diff --git a/doc/misc/sc.texi b/doc/misc/sc.texi index 1f7b73dd73..46b1841714 100644 --- a/doc/misc/sc.texi +++ b/doc/misc/sc.texi @@ -15,7 +15,7 @@ This document describes Supercite, an Emacs package for citing and attributing replies to mail and news messages. -Copyright @copyright{} 1993, 2001--2016 Free Software Foundation, Inc. +Copyright @copyright{} 1993, 2001--2017 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document diff --git a/doc/misc/semantic.texi b/doc/misc/semantic.texi index 2023f24e6f..1832017e60 100644 --- a/doc/misc/semantic.texi +++ b/doc/misc/semantic.texi @@ -25,7 +25,7 @@ @copying This manual documents the Semantic library and utilities. -Copyright @copyright{} 1999--2005, 2007, 2009--2016 Free Software +Copyright @copyright{} 1999--2005, 2007, 2009--2017 Free Software Foundation, Inc. @quotation diff --git a/doc/misc/ses.texi b/doc/misc/ses.texi index 58f9ba8ccf..1682401179 100644 --- a/doc/misc/ses.texi +++ b/doc/misc/ses.texi @@ -12,7 +12,7 @@ @copying This file documents @acronym{SES}: the Simple Emacs Spreadsheet. -Copyright @copyright{} 2002--2016 Free Software Foundation, Inc. +Copyright @copyright{} 2002--2017 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document diff --git a/doc/misc/sieve.texi b/doc/misc/sieve.texi index 5bc38d4893..253baf440f 100644 --- a/doc/misc/sieve.texi +++ b/doc/misc/sieve.texi @@ -12,7 +12,7 @@ @copying This file documents the Emacs Sieve package, for server-side mail filtering. -Copyright @copyright{} 2001--2016 Free Software Foundation, Inc. +Copyright @copyright{} 2001--2017 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document diff --git a/doc/misc/smtpmail.texi b/doc/misc/smtpmail.texi index d9a68c4598..824945856a 100644 --- a/doc/misc/smtpmail.texi +++ b/doc/misc/smtpmail.texi @@ -4,7 +4,7 @@ @include docstyle.texi @syncodeindex vr fn @copying -Copyright @copyright{} 2003--2016 Free Software Foundation, Inc. +Copyright @copyright{} 2003--2017 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document diff --git a/doc/misc/speedbar.texi b/doc/misc/speedbar.texi index d43c521f76..76ae0eb4d7 100644 --- a/doc/misc/speedbar.texi +++ b/doc/misc/speedbar.texi @@ -5,7 +5,7 @@ @syncodeindex fn cp @copying -Copyright @copyright{} 1999--2016 Free Software Foundation, Inc. +Copyright @copyright{} 1999--2017 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document diff --git a/doc/misc/srecode.texi b/doc/misc/srecode.texi index 9a5d717dfe..74904f37e1 100644 --- a/doc/misc/srecode.texi +++ b/doc/misc/srecode.texi @@ -16,7 +16,7 @@ @c %**end of header @copying -Copyright @copyright{} 2007--2016 Free Software Foundation, Inc. +Copyright @copyright{} 2007--2017 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index dae514033f..d75f10be97 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -35,7 +35,7 @@ @end macro @copying -Copyright @copyright{} 1999--2016 Free Software Foundation, Inc. +Copyright @copyright{} 1999--2017 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document diff --git a/doc/misc/url.texi b/doc/misc/url.texi index 91cb6b54a8..60d7ab2639 100644 --- a/doc/misc/url.texi +++ b/doc/misc/url.texi @@ -21,7 +21,7 @@ @copying This is the manual for the @code{url} Emacs Lisp library. -Copyright @copyright{} 1993--1999, 2002, 2004--2016 Free Software +Copyright @copyright{} 1993--1999, 2002, 2004--2017 Free Software Foundation, Inc. @quotation diff --git a/doc/misc/vhdl-mode.texi b/doc/misc/vhdl-mode.texi index e26ec5277c..05036c4401 100644 --- a/doc/misc/vhdl-mode.texi +++ b/doc/misc/vhdl-mode.texi @@ -10,7 +10,7 @@ @copying This file documents VHDL Mode, an Emacs mode for editing VHDL code. -Copyright @copyright{} 1995--2008, 2010, 2012, 2015--2016 Free Software +Copyright @copyright{} 1995--2008, 2010, 2012, 2015--2017 Free Software Foundation, Inc. @quotation diff --git a/doc/misc/vip.texi b/doc/misc/vip.texi index 0f7e8a729a..498d9aa847 100644 --- a/doc/misc/vip.texi +++ b/doc/misc/vip.texi @@ -4,7 +4,7 @@ @include docstyle.texi @copying -Copyright @copyright{} 1987, 2001--2016 Free Software Foundation, Inc. +Copyright @copyright{} 1987, 2001--2017 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document diff --git a/doc/misc/viper.texi b/doc/misc/viper.texi index 6b82653c62..3e944d99e7 100644 --- a/doc/misc/viper.texi +++ b/doc/misc/viper.texi @@ -8,7 +8,7 @@ @include docstyle.texi @copying -Copyright @copyright{} 1995--1997, 2001--2016 Free Software Foundation, Inc. +Copyright @copyright{} 1995--1997, 2001--2017 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document diff --git a/doc/misc/widget.texi b/doc/misc/widget.texi index 953bcae3ef..3c8b4c8819 100644 --- a/doc/misc/widget.texi +++ b/doc/misc/widget.texi @@ -9,7 +9,7 @@ @c %**end of header @copying -Copyright @copyright{} 2000--2016 Free Software Foundation, Inc. +Copyright @copyright{} 2000--2017 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document diff --git a/doc/misc/wisent.texi b/doc/misc/wisent.texi index b4efbdad1b..7f2ef0a236 100644 --- a/doc/misc/wisent.texi +++ b/doc/misc/wisent.texi @@ -24,7 +24,7 @@ @c %**end of header @copying -Copyright @copyright{} 1988--1993, 1995, 1998--2004, 2007, 2012--2016 +Copyright @copyright{} 1988--1993, 1995, 1998--2004, 2007, 2012--2017 Free Software Foundation, Inc. @c Since we are both GNU manuals, we do not need to ack each other here. diff --git a/doc/misc/woman.texi b/doc/misc/woman.texi index f1fbba6151..95cc0d1b80 100644 --- a/doc/misc/woman.texi +++ b/doc/misc/woman.texi @@ -15,7 +15,7 @@ This file documents WoMan: A program to browse Unix manual pages ``W.O. (without) man''. -Copyright @copyright{} 2001--2016 Free Software Foundation, Inc. +Copyright @copyright{} 2001--2017 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document diff --git a/etc/images/README b/etc/images/README index 7c48091c22..c5f6978661 100644 --- a/etc/images/README +++ b/etc/images/README @@ -31,15 +31,15 @@ File: mh-logo.xpm Files: gnus.pbm Author: Luis Fernandes - Copyright (C) 2001-2016 Free Software Foundation, Inc. + Copyright (C) 2001-2017 Free Software Foundation, Inc. Files: splash.png, splash.svg, splash.pbm, splash.xpm Author: Francesc Rocher - Copyright (C) 2008-2016 Free Software Foundation, Inc. + Copyright (C) 2008-2017 Free Software Foundation, Inc. Files: checked.xpm, unchecked.xpm Author: Chong Yidong - Copyright (C) 2010-2016 Free Software Foundation, Inc. + Copyright (C) 2010-2017 Free Software Foundation, Inc. * The following icons are from GTK+ 2.x. They are not part of Emacs, but diff --git a/etc/images/checked.xpm b/etc/images/checked.xpm index f09dd7cf06..033da686d5 100644 --- a/etc/images/checked.xpm +++ b/etc/images/checked.xpm @@ -1,5 +1,5 @@ /* XPM */ -/* Copyright (C) 2010-2016 Free Software Foundation, Inc. +/* Copyright (C) 2010-2017 Free Software Foundation, Inc. * * Author: Chong Yidong * diff --git a/etc/images/gnus/README b/etc/images/gnus/README index 0523215909..f1f8402d2d 100644 --- a/etc/images/gnus/README +++ b/etc/images/gnus/README @@ -21,11 +21,11 @@ Files: catchup.pbm catchup.xpm cu-exit.pbm cu-exit.xpm unsubscribe.pbm unsubscribe.xpm uu-decode.pbm uu-decode.xpm uu-post.pbm uu-post.xpm Author: Luis Fernandes -Copyright (C) 2001-2016 Free Software Foundation, Inc. +Copyright (C) 2001-2017 Free Software Foundation, Inc. Files: gnus.png, gnus.svg Author: Francesc Rocher - Copyright (C) 2008-2016 Free Software Foundation, Inc. + Copyright (C) 2008-2017 Free Software Foundation, Inc. * The following icons are from GNOME 2.x. They are not part of Emacs, diff --git a/etc/images/gud/README b/etc/images/gud/README index 82689b775f..054f6113d6 100644 --- a/etc/images/gud/README +++ b/etc/images/gud/README @@ -31,7 +31,7 @@ their copyright assignment included the icons. The following icons are converted from the Insight Windows style icon set in src/gdb/gdbtk/library/images2. -Copyright (C) 2002-2016 Free Software Foundation, Inc. +Copyright (C) 2002-2017 Free Software Foundation, Inc. License: GNU General Public License version 3 or later (see COPYING) cont.pbm and cont.xpm were converted from continue.gif @@ -47,7 +47,7 @@ License: GNU General Public License version 3 or later (see COPYING) The following icons are created from the Insight Windows style icon set in src/gdb/gdbtk/library/images2. -Copyright (C) 2002-2016 Free Software Foundation, Inc. +Copyright (C) 2002-2017 Free Software Foundation, Inc. License: GNU General Public License version 3 or later (see COPYING) rcont.xpm rfinish.xpm diff --git a/etc/images/icons/README b/etc/images/icons/README index 0f3d56244e..9a1cb5b5bd 100644 --- a/etc/images/icons/README +++ b/etc/images/icons/README @@ -14,7 +14,7 @@ Files: hicolor/16x16/apps/emacs23.png hicolor/24x24/apps/emacs23.png hicolor/128x128/apps/emacs23.png hicolor/scalable/apps/emacs23.svg Author: Kentaro Ohkouchi -Copyright (C) 2007-2016 Free Software Foundation, Inc. +Copyright (C) 2007-2017 Free Software Foundation, Inc. License: GNU General Public License version 3 or later (see COPYING) @@ -22,7 +22,7 @@ Files: hicolor/16x16/apps/emacs22.png hicolor/24x24/apps/emacs22.png hicolor/32x32/apps/emacs22.png hicolor/48x48/apps/emacs22.png Author: Andrew Zhilin -Copyright (C) 2005-2016 Free Software Foundation, Inc. +Copyright (C) 2005-2017 Free Software Foundation, Inc. License: GNU General Public License version 3 or later (see COPYING) Files: allout-widgets-dark-bg/closed.png @@ -71,5 +71,5 @@ Files: allout-widgets-dark-bg/closed.png allout-widgets-light-bg/through-descender.xpm Author: Ken Manheimer -Copyright (C) 2011-2016 Free Software Foundation, Inc. +Copyright (C) 2011-2017 Free Software Foundation, Inc. License: GNU General Public License version 3 or later (see COPYING) diff --git a/etc/images/mh-logo.xpm b/etc/images/mh-logo.xpm index 3b5d6ebff5..b2017c6f63 100644 --- a/etc/images/mh-logo.xpm +++ b/etc/images/mh-logo.xpm @@ -1,7 +1,7 @@ /* XPM */ /* MH-E Logo * - * Copyright (C) 2003-2016 Free Software Foundation, Inc. + * Copyright (C) 2003-2017 Free Software Foundation, Inc. * * Author: Satyaki Das * diff --git a/etc/images/unchecked.xpm b/etc/images/unchecked.xpm index de6a0d995a..f7ca8609f2 100644 --- a/etc/images/unchecked.xpm +++ b/etc/images/unchecked.xpm @@ -1,5 +1,5 @@ /* XPM */ -/* Copyright (C) 2010-2016 Free Software Foundation, Inc. +/* Copyright (C) 2010-2017 Free Software Foundation, Inc. * * Author: Chong Yidong * diff --git a/etc/refcards/README b/etc/refcards/README index 666beaf9fa..178cb9290d 100644 --- a/etc/refcards/README +++ b/etc/refcards/README @@ -32,7 +32,7 @@ it is reproduced here for convenience. File: gnus-logo.eps, gnus-logo.pdf Author: Luis Fernandes - Copyright (C) 2001-2016 Free Software Foundation, Inc. + Copyright (C) 2001-2017 Free Software Foundation, Inc. License: GNU General Public License version 3 or later (see COPYING) diff --git a/etc/refcards/gnus-refcard.tex b/etc/refcards/gnus-refcard.tex index 6e5f2c3614..676820835f 100644 --- a/etc/refcards/gnus-refcard.tex +++ b/etc/refcards/gnus-refcard.tex @@ -120,7 +120,7 @@ %% Gnus logo by Luis Fernandes. \newcommand{\Copyright}{% \begin{center} - Copyright \copyright\ 1995, 2000, 2002--2016 Free Software Foundation, Inc.\\* + Copyright \copyright\ 1995, 2000, 2002--2017 Free Software Foundation, Inc.\\* \end{center} Released under the terms of the GNU General Public License version 3 or later. diff --git a/etc/tutorials/TUTORIAL.cn b/etc/tutorials/TUTORIAL.cn index 1d55ca238e..fe8f500aaf 100644 --- a/etc/tutorials/TUTORIAL.cn +++ b/etc/tutorials/TUTORIAL.cn @@ -1026,7 +1026,7 @@ using, writing, and sharing free software! 本篇指南是 GNU Emacs 的一部分，并允许在下列条件的约束下发行其拷贝： - Copyright (C) 1985, 1996, 1998, 2001-2016 Free Software Foundation, + Copyright (C) 1985, 1996, 1998, 2001-2017 Free Software Foundation, Inc. 本文件为 GNU Emacs 的一部分。 diff --git a/etc/tutorials/TUTORIAL.he b/etc/tutorials/TUTORIAL.he index 566207a9be..523a466ec0 100644 --- a/etc/tutorials/TUTORIAL.he +++ b/etc/tutorials/TUTORIAL.he @@ -996,7 +996,7 @@ find-file. גירסה זו של השיעור הינה חלק מחבילת GNU Emacs. היא מוגנת בזכויות יוצרים וניתנת להעתקה והפצת עותקים בתנאים מסויימים כדלקמן: - Copyright (C) 2010-2016 Free Software Foundation, Inc. + Copyright (C) 2010-2017 Free Software Foundation, Inc. ‏GNU Emacs הינו תכנה חפשית; זכותכם להפיצו ו\או לשנותו בכפוף לתנאי הרשיון GNU General Public License, כפי שהוא יוצא לאור ע״י Free diff --git a/etc/tutorials/TUTORIAL.nl b/etc/tutorials/TUTORIAL.nl index cc5b116d74..d0453bdfd6 100644 --- a/etc/tutorials/TUTORIAL.nl +++ b/etc/tutorials/TUTORIAL.nl @@ -1239,7 +1239,7 @@ Engels origineel van de copyrightmelding en condities: This version of the tutorial is a part of GNU Emacs. It is copyrighted and comes with permission to distribute copies on certain conditions: - Copyright (C) 1985, 1996, 1998, 2001-2016 Free Software Foundation, Inc. + Copyright (C) 1985, 1996, 1998, 2001-2017 Free Software Foundation, Inc. This file is part of GNU Emacs. diff --git a/etc/tutorials/TUTORIAL.ro b/etc/tutorials/TUTORIAL.ro index f5b88d316a..c5c25e3d2c 100644 --- a/etc/tutorials/TUTORIAL.ro +++ b/etc/tutorials/TUTORIAL.ro @@ -1082,7 +1082,7 @@ continuare noţita de copyright originală în limba engleză. This version of the tutorial, like GNU Emacs, is copyrighted, and comes with permission to distribute copies on certain conditions: -Copyright (C) 1998, 2001-2016 Free Software Foundation, Inc. +Copyright (C) 1998, 2001-2017 Free Software Foundation, Inc. Permission is granted to anyone to make or distribute verbatim copies of this document as received, in any medium, provided that the diff --git a/etc/tutorials/TUTORIAL.sl b/etc/tutorials/TUTORIAL.sl index 38b15e74bc..4e59341f8c 100644 --- a/etc/tutorials/TUTORIAL.sl +++ b/etc/tutorials/TUTORIAL.sl @@ -1119,7 +1119,7 @@ Emacs. V slovenščino ga je prevedel Primož Peterlin. To besedilo, kot sam GNU Emacs, je avtorsko delo, in njegovo razmnoževanje in razširjanje je dovoljeno pod naslednjimi pogoji: -Copyright © 1985, 1996, 1998, 2001-2016 Free Software Foundation, Inc. +Copyright © 1985, 1996, 1998, 2001-2017 Free Software Foundation, Inc. Ta datoteka je del paketa GNU Emacs. diff --git a/lib-src/rcs2log b/lib-src/rcs2log index 828e4bd095..1a1771b2b2 100755 --- a/lib-src/rcs2log +++ b/lib-src/rcs2log @@ -20,7 +20,7 @@ # along with this program. If not, see . -Copyright='Copyright (C) 2016 Free Software Foundation, Inc. +Copyright='Copyright (C) 2017 Free Software Foundation, Inc. This program comes with NO WARRANTY, to the extent permitted by law. You may redistribute copies of this program under the terms of the GNU General Public License. diff --git a/lib/getopt_.h b/lib/getopt_.h index a20446401f..7c77a1c8d4 100644 --- a/lib/getopt_.h +++ b/lib/getopt_.h @@ -130,7 +130,7 @@ /* The definition of _GL_ARG_NONNULL is copied here. */ /* A C macro for declaring that specific arguments must not be NULL. - Copyright (C) 2009-2016 Free Software Foundation, Inc. + Copyright (C) 2009-2017 Free Software Foundation, Inc. This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index 2b022c4905..0b07941000 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -1,6 +1,6 @@ ;;; cl-preloaded.el --- Preloaded part of the CL library -*- lexical-binding: t; -*- -;; Copyright (C) 2015-2016 Free Software Foundation, Inc +;; Copyright (C) 2015-2017 Free Software Foundation, Inc ;; Author: Stefan Monnier ;; Package: emacs diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 989c62069a..22b65a7e16 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -791,7 +791,7 @@ on the remote host.") (defconst tramp-perl-encode "%s -e ' # This script contributed by Juanma Barranquero . -# Copyright (C) 2002-2016 Free Software Foundation, Inc. +# Copyright (C) 2002-2017 Free Software Foundation, Inc. use strict; my %%trans = do { @@ -829,7 +829,7 @@ This string is passed to `format', so percent characters need to be doubled.") (defconst tramp-perl-decode "%s -e ' # This script contributed by Juanma Barranquero . -# Copyright (C) 2002-2016 Free Software Foundation, Inc. +# Copyright (C) 2002-2017 Free Software Foundation, Inc. use strict; my %%trans = do { diff --git a/msdos/README b/msdos/README index 4ad1097bd5..122e8150e4 100644 --- a/msdos/README +++ b/msdos/README @@ -10,7 +10,7 @@ The files emacs.ico and emacs.pif are for using the DJGPP version on Windows 3.X. Since these are binary files, their copyright notice is reproduced here: -# Copyright (C) 1993, 2002-2016 Free Software Foundation, Inc. +# Copyright (C) 1993, 2002-2017 Free Software Foundation, Inc. # # This file is part of GNU Emacs. # diff --git a/msdos/autogen/Makefile.in b/msdos/autogen/Makefile.in index d21c3ae635..6c3af73cfe 100644 --- a/msdos/autogen/Makefile.in +++ b/msdos/autogen/Makefile.in @@ -13,7 +13,7 @@ @SET_MAKE@ -# Copyright (C) 2002-2016 Free Software Foundation, Inc. +# Copyright (C) 2002-2017 Free Software Foundation, Inc. # # This file is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by @@ -36,7 +36,7 @@ # Generated by gnulib-tool. # Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --avoid=close --avoid=dup --avoid=fchdir --avoid=fstat --avoid=malloc-posix --avoid=msvc-inval --avoid=msvc-nothrow --avoid=open --avoid=openat-die --avoid=opendir --avoid=raise --avoid=save-cwd --avoid=select --avoid=sigprocmask --avoid=sys_types --avoid=threadlib --makefile-name=gnulib.mk --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files alloca-opt byteswap c-ctype c-strcase careadlinkat close-stream count-one-bits count-trailing-zeros crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 dtoastr dtotimespec dup2 environ execinfo faccessat fcntl fcntl-h fdatasync fdopendir filemode fstatat fsync getloadavg getopt-gnu gettime gettimeofday intprops largefile lstat manywarnings memrchr mkostemp mktime pipe2 pselect pthread_sigmask putenv qacl readlink readlinkat sig2str socklen stat-time stdalign stdarg stdbool stdio strftime strtoimax strtoumax symlink sys_stat sys_time time timer-time timespec-add timespec-sub unsetenv utimens warnings -# Copyright (C) 2002-2016 Free Software Foundation, Inc. +# Copyright (C) 2002-2017 Free Software Foundation, Inc. # # This file is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by diff --git a/msdos/depfiles.bat b/msdos/depfiles.bat index 76a00ec714..b2c7bc8230 100644 --- a/msdos/depfiles.bat +++ b/msdos/depfiles.bat @@ -1,7 +1,7 @@ @echo off rem ---------------------------------------------------------------------- rem Auxiliary script for MSDOS, run by ../config.bat -rem Copyright (C) 2011-2016 Free Software Foundation, Inc. +rem Copyright (C) 2011-2017 Free Software Foundation, Inc. rem This file is part of GNU Emacs. diff --git a/msdos/sed2v2.inp b/msdos/sed2v2.inp index 743f5dc1ad..7d0d7e9623 100644 --- a/msdos/sed2v2.inp +++ b/msdos/sed2v2.inp @@ -27,7 +27,7 @@ #ifndef MSDOS\ #define MSDOS\ #endif -/^#undef COPYRIGHT *$/s/^.*$/#define COPYRIGHT "Copyright (C) 2016 Free Software Foundation, Inc."/ +/^#undef COPYRIGHT *$/s/^.*$/#define COPYRIGHT "Copyright (C) 2017 Free Software Foundation, Inc."/ /^#undef DIRECTORY_SEP *$/s!^.*$!#define DIRECTORY_SEP '/'! /^#undef DOS_NT *$/s/^.*$/#define DOS_NT/ /^#undef FLOAT_CHECK_DOMAIN *$/s/^.*$/#define FLOAT_CHECK_DOMAIN/ diff --git a/nt/configure.bat b/nt/configure.bat index b5f659532a..cd2a8f4f28 100755 --- a/nt/configure.bat +++ b/nt/configure.bat @@ -1,7 +1,7 @@ @echo off rem ---------------------------------------------------------------------- rem This was the old configuration script for MS Windows operating systems -rem Copyright (C) 1999-2016 Free Software Foundation, Inc. +rem Copyright (C) 1999-2017 Free Software Foundation, Inc. rem This file is part of GNU Emacs. diff --git a/nt/emacs.rc.in b/nt/emacs.rc.in index 542af86349..abf5de1e4e 100644 --- a/nt/emacs.rc.in +++ b/nt/emacs.rc.in @@ -31,7 +31,7 @@ BEGIN VALUE "FileDescription", "GNU Emacs: The extensible self-documenting text editor\0" VALUE "FileVersion", "@comma_space_version@\0" VALUE "InternalName", "Emacs\0" - VALUE "LegalCopyright", "Copyright (C) 2001-2016\0" + VALUE "LegalCopyright", "Copyright (C) 2001-2017\0" VALUE "OriginalFilename", "emacs.exe" VALUE "ProductName", "Emacs\0" VALUE "ProductVersion", "@comma_space_version@\0" diff --git a/nt/emacsclient.rc.in b/nt/emacsclient.rc.in index 147d145738..d68fff78bf 100644 --- a/nt/emacsclient.rc.in +++ b/nt/emacsclient.rc.in @@ -25,7 +25,7 @@ BEGIN VALUE "FileDescription", "GNU EmacsClient: Client for the extensible self-documenting text editor\0" VALUE "FileVersion", "@comma_space_version@\0" VALUE "InternalName", "EmacsClient\0" - VALUE "LegalCopyright", "Copyright (C) 2001-2016\0" + VALUE "LegalCopyright", "Copyright (C) 2001-2017\0" VALUE "OriginalFilename", "emacsclientw.exe" VALUE "ProductName", "EmacsClient\0" VALUE "ProductVersion", "@comma_space_version@\0" diff --git a/nt/icons/README b/nt/icons/README index 3b0934749e..46276ca84d 100644 --- a/nt/icons/README +++ b/nt/icons/README @@ -8,7 +8,7 @@ License: GNU General Public License version 3 or later File: emacs22.ico Author: Andrew Zhilin -Copyright (C) 2005-2016 Free Software Foundation, Inc. +Copyright (C) 2005-2017 Free Software Foundation, Inc. License: GNU General Public License version 3 or later (see COPYING) @@ -17,7 +17,7 @@ Files: gnu2a32.ico gnu2a32t.ico gnu2b48.ico gnu2b48t.ico gnu5w32.ico gnu5w32t.ico gnu6w48.ico gnu6w48t.ico gnu7.ico gnu8.ico gnu9.ico Author: Rob Davenport -Copyright (C) 1999, 2001-2016 Free Software Foundation, Inc. +Copyright (C) 1999, 2001-2017 Free Software Foundation, Inc. License: GNU General Public License version 3 or later (see COPYING) commit 5badc81c1cdfbb261ad3e6d1b753defb15712f26 Author: Paul Eggert Date: Sun Jan 1 03:14:01 2017 +0000 Update copyright year to 2017 Run admin/update-copyright. diff --git a/.gitattributes b/.gitattributes index 5ccf9a5eab..fc9cde942a 100644 --- a/.gitattributes +++ b/.gitattributes @@ -1,6 +1,6 @@ # Attributes of Emacs files in the Git repository. -# Copyright 2015-2016 Free Software Foundation, Inc. +# Copyright 2015-2017 Free Software Foundation, Inc. # This file is part of GNU Emacs. diff --git a/.gitignore b/.gitignore index 7c8b74336d..6804a23bce 100644 --- a/.gitignore +++ b/.gitignore @@ -1,6 +1,6 @@ # Files that Git should ignore in the Emacs source directory. -# Copyright 2009-2016 Free Software Foundation, Inc. +# Copyright 2009-2017 Free Software Foundation, Inc. # This file is part of GNU Emacs. diff --git a/ChangeLog.1 b/ChangeLog.1 index dee582f47b..eeb6da4265 100644 --- a/ChangeLog.1 +++ b/ChangeLog.1 @@ -14700,7 +14700,7 @@ ;; coding: utf-8 ;; End: - Copyright (C) 1993-1999, 2001-2016 Free Software Foundation, Inc. + Copyright (C) 1993-1999, 2001-2017 Free Software Foundation, Inc. This file is part of GNU Emacs. diff --git a/ChangeLog.2 b/ChangeLog.2 index a055862ae5..0ad6b51f26 100644 --- a/ChangeLog.2 +++ b/ChangeLog.2 @@ -35320,7 +35320,7 @@ See ChangeLog.1 for earlier changes. ;; coding: utf-8 ;; End: - Copyright (C) 2015-2016 Free Software Foundation, Inc. + Copyright (C) 2015-2017 Free Software Foundation, Inc. This file is part of GNU Emacs. diff --git a/GNUmakefile b/GNUmakefile index 83bb718a96..ff6c8ff779 100644 --- a/GNUmakefile +++ b/GNUmakefile @@ -1,6 +1,6 @@ # Build Emacs from a fresh tarball or version-control checkout. -# Copyright (C) 2011-2016 Free Software Foundation, Inc. +# Copyright (C) 2011-2017 Free Software Foundation, Inc. # # This file is part of GNU Emacs. # diff --git a/INSTALL b/INSTALL index ade9bcbf46..b075abb300 100644 --- a/INSTALL +++ b/INSTALL @@ -1,5 +1,5 @@ GNU Emacs Installation Guide -Copyright (C) 1992, 1994, 1996-1997, 2000-2016 Free Software Foundation, +Copyright (C) 1992, 1994, 1996-1997, 2000-2017 Free Software Foundation, Inc. See the end of the file for license conditions. diff --git a/INSTALL.REPO b/INSTALL.REPO index 1720758928..d950d1bb64 100644 --- a/INSTALL.REPO +++ b/INSTALL.REPO @@ -64,7 +64,7 @@ never platform-specific. -Copyright (C) 2002-2016 Free Software Foundation, Inc. +Copyright (C) 2002-2017 Free Software Foundation, Inc. This file is part of GNU Emacs. diff --git a/Makefile.in b/Makefile.in index 9600c1199a..bba9bb158c 100644 --- a/Makefile.in +++ b/Makefile.in @@ -1,6 +1,6 @@ ### @configure_input@ -# Copyright (C) 1992-2016 Free Software Foundation, Inc. +# Copyright (C) 1992-2017 Free Software Foundation, Inc. # This file is part of GNU Emacs. diff --git a/README b/README index 1ca9ebe95c..ab31bbcebd 100644 --- a/README +++ b/README @@ -1,4 +1,4 @@ -Copyright (C) 2001-2016 Free Software Foundation, Inc. +Copyright (C) 2001-2017 Free Software Foundation, Inc. See the end of the file for license conditions. diff --git a/admin/ChangeLog.1 b/admin/ChangeLog.1 index c7cae0cbac..b1aaee7cb6 100644 --- a/admin/ChangeLog.1 +++ b/admin/ChangeLog.1 @@ -2577,7 +2577,7 @@ ;; coding: utf-8 ;; End: - Copyright (C) 2001-2016 Free Software Foundation, Inc. + Copyright (C) 2001-2017 Free Software Foundation, Inc. This file is part of GNU Emacs. diff --git a/admin/README b/admin/README index 7184015995..cb6ba85992 100644 --- a/admin/README +++ b/admin/README @@ -1,4 +1,4 @@ -Copyright (C) 2001-2016 Free Software Foundation, Inc. +Copyright (C) 2001-2017 Free Software Foundation, Inc. See the end of the file for license conditions. diff --git a/admin/admin.el b/admin/admin.el index 9f3b68e0bb..4892045a69 100644 --- a/admin/admin.el +++ b/admin/admin.el @@ -1,6 +1,6 @@ ;;; admin.el --- utilities for Emacs administration -;; Copyright (C) 2001-2016 Free Software Foundation, Inc. +;; Copyright (C) 2001-2017 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. diff --git a/admin/alloc-colors.c b/admin/alloc-colors.c index 3158cf40ba..fa6a639d88 100644 --- a/admin/alloc-colors.c +++ b/admin/alloc-colors.c @@ -1,6 +1,6 @@ /* Allocate X colors. Used for testing with dense colormaps. -Copyright (C) 2001-2016 Free Software Foundation, Inc. +Copyright (C) 2001-2017 Free Software Foundation, Inc. This file is part of GNU Emacs. diff --git a/admin/authors.el b/admin/authors.el index 5a97c854a6..69f1c96983 100644 --- a/admin/authors.el +++ b/admin/authors.el @@ -1,6 +1,6 @@ ;;; authors.el --- utility for maintaining Emacs's AUTHORS file -;; Copyright (C) 2000-2016 Free Software Foundation, Inc. +;; Copyright (C) 2000-2017 Free Software Foundation, Inc. ;; Author: Gerd Moellmann ;; Maintainer: Kim F. Storm diff --git a/admin/build-configs b/admin/build-configs index 928ea4f2e0..aa62dadc91 100755 --- a/admin/build-configs +++ b/admin/build-configs @@ -1,7 +1,7 @@ #! /usr/bin/perl # Build Emacs in several different configurations. -# Copyright (C) 2001-2016 Free Software Foundation, Inc. +# Copyright (C) 2001-2017 Free Software Foundation, Inc. # This file is part of GNU Emacs. diff --git a/admin/bzrmerge.el b/admin/bzrmerge.el index 1de7bc445e..46a5e42aa7 100644 --- a/admin/bzrmerge.el +++ b/admin/bzrmerge.el @@ -1,6 +1,6 @@ ;;; bzrmerge.el --- help merge one Emacs bzr branch to another -;; Copyright (C) 2010-2016 Free Software Foundation, Inc. +;; Copyright (C) 2010-2017 Free Software Foundation, Inc. ;; Author: Stefan Monnier ;; Keywords: maint diff --git a/admin/charsets/Makefile.in b/admin/charsets/Makefile.in index 0ca7e14d85..b154bc13d4 100644 --- a/admin/charsets/Makefile.in +++ b/admin/charsets/Makefile.in @@ -1,6 +1,6 @@ ### @configure_input@ -# Copyright (C) 2015-2016 Free Software Foundation, Inc. +# Copyright (C) 2015-2017 Free Software Foundation, Inc. # Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 # National Institute of Advanced Industrial Science and Technology (AIST) diff --git a/admin/charsets/mapconv b/admin/charsets/mapconv index 5a72fbd6c7..5f62ff90d3 100755 --- a/admin/charsets/mapconv +++ b/admin/charsets/mapconv @@ -1,6 +1,6 @@ #!/bin/sh -# Copyright (C) 2015-2016 Free Software Foundation, Inc. +# Copyright (C) 2015-2017 Free Software Foundation, Inc. # Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 # National Institute of Advanced Industrial Science and Technology (AIST) diff --git a/admin/charsets/mapfiles/README b/admin/charsets/mapfiles/README index fb200e59a8..f9dc2ba99f 100644 --- a/admin/charsets/mapfiles/README +++ b/admin/charsets/mapfiles/README @@ -1,4 +1,4 @@ -Copyright (C) 2009-2016 Free Software Foundation, Inc. +Copyright (C) 2009-2017 Free Software Foundation, Inc. Copyright (C) 2009, 2010, 2011 National Institute of Advanced Industrial Science and Technology (AIST) Registration Number H13PRO009 diff --git a/admin/cus-test.el b/admin/cus-test.el index 3a4fd1237d..3808a44eff 100644 --- a/admin/cus-test.el +++ b/admin/cus-test.el @@ -1,6 +1,6 @@ ;;; cus-test.el --- tests for custom types and load problems -;; Copyright (C) 1998, 2000, 2002-2016 Free Software Foundation, Inc. +;; Copyright (C) 1998, 2000, 2002-2017 Free Software Foundation, Inc. ;; Author: Markus Rost ;; Maintainer: Markus Rost diff --git a/admin/diff-tar-files b/admin/diff-tar-files index ddb107b6af..23df9ff192 100755 --- a/admin/diff-tar-files +++ b/admin/diff-tar-files @@ -1,6 +1,6 @@ #! /bin/sh -# Copyright (C) 2001-2016 Free Software Foundation, Inc. +# Copyright (C) 2001-2017 Free Software Foundation, Inc. # This file is part of GNU Emacs. diff --git a/admin/find-gc.el b/admin/find-gc.el index 26bbc5448d..53ac922040 100644 --- a/admin/find-gc.el +++ b/admin/find-gc.el @@ -1,6 +1,6 @@ ;;; find-gc.el --- detect functions that call the garbage collector -;; Copyright (C) 1992, 2001-2016 Free Software Foundation, Inc. +;; Copyright (C) 1992, 2001-2017 Free Software Foundation, Inc. ;; Maintainer: emacs-devel@gnu.org diff --git a/admin/gitmerge.el b/admin/gitmerge.el index b74c128ae5..73ddd15b29 100644 --- a/admin/gitmerge.el +++ b/admin/gitmerge.el @@ -1,6 +1,6 @@ ;;; gitmerge.el --- help merge one Emacs branch into another -;; Copyright (C) 2010-2016 Free Software Foundation, Inc. +;; Copyright (C) 2010-2017 Free Software Foundation, Inc. ;; Authors: David Engster ;; Stefan Monnier diff --git a/admin/grammars/Makefile.in b/admin/grammars/Makefile.in index 9037343c81..fd1d8954e5 100644 --- a/admin/grammars/Makefile.in +++ b/admin/grammars/Makefile.in @@ -1,6 +1,6 @@ ### @configure_input@ -## Copyright (C) 2013-2016 Free Software Foundation, Inc. +## Copyright (C) 2013-2017 Free Software Foundation, Inc. ## This file is part of GNU Emacs. diff --git a/admin/grammars/c.by b/admin/grammars/c.by index be41bd8d2b..c312fd636d 100644 --- a/admin/grammars/c.by +++ b/admin/grammars/c.by @@ -1,5 +1,5 @@ ;;; c.by -- LL grammar for C/C++ language specification -;; Copyright (C) 1999-2016 Free Software Foundation, Inc. +;; Copyright (C) 1999-2017 Free Software Foundation, Inc. ;; ;; Author: Eric M. Ludlam ;; David Ponce diff --git a/admin/grammars/grammar.wy b/admin/grammars/grammar.wy index 9bac0988c5..ffbe7cc4a9 100644 --- a/admin/grammars/grammar.wy +++ b/admin/grammars/grammar.wy @@ -1,6 +1,6 @@ ;;; semantic-grammar.wy -- LALR grammar of Semantic input grammars ;; -;; Copyright (C) 2002-2016 Free Software Foundation, Inc. +;; Copyright (C) 2002-2017 Free Software Foundation, Inc. ;; ;; Author: David Ponce ;; Maintainer: David Ponce diff --git a/admin/grammars/java-tags.wy b/admin/grammars/java-tags.wy index 7284f0242b..bbad38d23f 100644 --- a/admin/grammars/java-tags.wy +++ b/admin/grammars/java-tags.wy @@ -1,6 +1,6 @@ ;;; java-tags.wy -- Semantic LALR grammar for Java -;; Copyright (C) 2002-2016 Free Software Foundation, Inc. +;; Copyright (C) 2002-2017 Free Software Foundation, Inc. ;; ;; Author: David Ponce ;; Maintainer: David Ponce diff --git a/admin/grammars/js.wy b/admin/grammars/js.wy index a49952f52d..72b662e179 100644 --- a/admin/grammars/js.wy +++ b/admin/grammars/js.wy @@ -1,6 +1,6 @@ ;;; javascript-jv.wy -- LALR grammar for Javascript -;; Copyright (C) 2005-2016 Free Software Foundation, Inc. +;; Copyright (C) 2005-2017 Free Software Foundation, Inc. ;; Copyright (C) 1998-2011 Ecma International. ;; Author: Joakim Verona diff --git a/admin/grammars/make.by b/admin/grammars/make.by index a9a856432d..0bfde31979 100644 --- a/admin/grammars/make.by +++ b/admin/grammars/make.by @@ -1,6 +1,6 @@ ;;; make.by -- BY notation for Makefiles. -;; Copyright (C) 1999-2016 Free Software Foundation, Inc. +;; Copyright (C) 1999-2017 Free Software Foundation, Inc. ;; ;; Author: Eric M. Ludlam ;; David Ponce diff --git a/admin/grammars/python.wy b/admin/grammars/python.wy index 4db3548eb0..23aa65cd7f 100644 --- a/admin/grammars/python.wy +++ b/admin/grammars/python.wy @@ -1,6 +1,6 @@ ;;; python.wy -- LALR grammar for Python -;; Copyright (C) 2002-2016 Free Software Foundation, Inc. +;; Copyright (C) 2002-2017 Free Software Foundation, Inc. ;; Copyright (c) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, ;; 2009, 2010 Python Software Foundation; All Rights Reserved diff --git a/admin/grammars/scheme.by b/admin/grammars/scheme.by index c1613c8d63..c4d6a392f7 100644 --- a/admin/grammars/scheme.by +++ b/admin/grammars/scheme.by @@ -1,6 +1,6 @@ ;;; scheme.by -- Scheme BNF language specification -;; Copyright (C) 2001-2016 Free Software Foundation, Inc. +;; Copyright (C) 2001-2017 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. diff --git a/admin/grammars/srecode-template.wy b/admin/grammars/srecode-template.wy index 33c8d24eed..811a324060 100644 --- a/admin/grammars/srecode-template.wy +++ b/admin/grammars/srecode-template.wy @@ -1,6 +1,6 @@ ;;; srecode-template.wy --- Semantic Recoder Template parser -;; Copyright (C) 2005-2016 Free Software Foundation, Inc. +;; Copyright (C) 2005-2017 Free Software Foundation, Inc. ;; Author: Eric Ludlam ;; Keywords: syntax diff --git a/admin/make-emacs b/admin/make-emacs index 6a79cdc723..4c735065e5 100755 --- a/admin/make-emacs +++ b/admin/make-emacs @@ -2,7 +2,7 @@ # Build Emacs with various options for profiling, debugging, # with and without warnings enabled etc. -# Copyright (C) 2001-2016 Free Software Foundation, Inc. +# Copyright (C) 2001-2017 Free Software Foundation, Inc. # This file is part of GNU Emacs. diff --git a/admin/merge-gnulib b/admin/merge-gnulib index 40b5b78ee8..8022fb3ed7 100755 --- a/admin/merge-gnulib +++ b/admin/merge-gnulib @@ -4,7 +4,7 @@ # # admin/merge-gnulib -# Copyright 2012-2016 Free Software Foundation, Inc. +# Copyright 2012-2017 Free Software Foundation, Inc. # This file is part of GNU Emacs. diff --git a/admin/merge-pkg-config b/admin/merge-pkg-config index 2066c9b4a2..363d22dfa5 100755 --- a/admin/merge-pkg-config +++ b/admin/merge-pkg-config @@ -4,7 +4,7 @@ # # admin/merge-pkg-config -# Copyright 2014-2016 Free Software Foundation, Inc. +# Copyright 2014-2017 Free Software Foundation, Inc. # This file is part of GNU Emacs. diff --git a/admin/notes/copyright b/admin/notes/copyright index 2dc33c164a..16144fb852 100644 --- a/admin/notes/copyright +++ b/admin/notes/copyright @@ -1,4 +1,4 @@ -Copyright (C) 2007-2016 Free Software Foundation, Inc. +Copyright (C) 2007-2017 Free Software Foundation, Inc. See the end of the file for license conditions. diff --git a/admin/notes/font-backend b/admin/notes/font-backend index 5b65ae5b25..2418966c93 100644 --- a/admin/notes/font-backend +++ b/admin/notes/font-backend @@ -1,4 +1,4 @@ -Copyright (C) 2002-2016 Free Software Foundation, Inc. +Copyright (C) 2002-2017 Free Software Foundation, Inc. See the end of the file for license conditions. diff --git a/admin/notes/hydra b/admin/notes/hydra index aadc169018..d5959354b0 100644 --- a/admin/notes/hydra +++ b/admin/notes/hydra @@ -1,6 +1,6 @@ -*- mode: outline; coding: utf-8 -*- -Copyright (C) 2013-2016 Free Software Foundation, Inc. +Copyright (C) 2013-2017 Free Software Foundation, Inc. See the end of the file for license conditions. NOTES FOR EMACS CONTINUOUS BUILD ON HYDRA diff --git a/admin/notes/multi-tty b/admin/notes/multi-tty index ac1c7b283a..b58180e6fa 100644 --- a/admin/notes/multi-tty +++ b/admin/notes/multi-tty @@ -1,6 +1,6 @@ -*- coding: utf-8; mode: text; -*- -Copyright (C) 2007-2016 Free Software Foundation, Inc. +Copyright (C) 2007-2017 Free Software Foundation, Inc. See the end of the file for license conditions. From README.multi-tty in the multi-tty branch. diff --git a/admin/notes/unicode b/admin/notes/unicode index d149459a9d..ea3ad9aee7 100644 --- a/admin/notes/unicode +++ b/admin/notes/unicode @@ -1,6 +1,6 @@ -*-mode: text; coding: utf-8;-*- -Copyright (C) 2002-2016 Free Software Foundation, Inc. +Copyright (C) 2002-2017 Free Software Foundation, Inc. See the end of the file for license conditions. Importing a new Unicode Standard version into Emacs diff --git a/admin/notes/www b/admin/notes/www index eddaa91ab3..8e911a44d5 100644 --- a/admin/notes/www +++ b/admin/notes/www @@ -1,6 +1,6 @@ -*- outline -*- -Copyright (C) 2013-2016 Free Software Foundation, Inc. +Copyright (C) 2013-2017 Free Software Foundation, Inc. See the end of the file for license conditions. NOTES FOR EMACS WWW PAGES diff --git a/admin/nt/README-UNDUMP.W32 b/admin/nt/README-UNDUMP.W32 index 3cd25c3a4c..f421416123 100644 --- a/admin/nt/README-UNDUMP.W32 +++ b/admin/nt/README-UNDUMP.W32 @@ -1,4 +1,4 @@ -Copyright (C) 2001-2016 Free Software Foundation, Inc. +Copyright (C) 2001-2017 Free Software Foundation, Inc. See the end of the file for license conditions. Emacs for Windows diff --git a/admin/nt/README-ftp-server b/admin/nt/README-ftp-server index 337be1a456..5fd363c2eb 100644 --- a/admin/nt/README-ftp-server +++ b/admin/nt/README-ftp-server @@ -1,4 +1,4 @@ -Copyright (C) 2001-2016 Free Software Foundation, Inc. +Copyright (C) 2001-2017 Free Software Foundation, Inc. See the end of the file for license conditions. Precompiled Distributions of diff --git a/admin/quick-install-emacs b/admin/quick-install-emacs index b1b3793aff..a5ec6965b1 100755 --- a/admin/quick-install-emacs +++ b/admin/quick-install-emacs @@ -1,7 +1,7 @@ #!/bin/sh ### quick-install-emacs --- do a halfway-decent job of installing emacs quickly -## Copyright (C) 2001-2016 Free Software Foundation, Inc. +## Copyright (C) 2001-2017 Free Software Foundation, Inc. ## Author: Miles Bader diff --git a/admin/unidata/Makefile.in b/admin/unidata/Makefile.in index d46420d0a3..f58303b6d7 100644 --- a/admin/unidata/Makefile.in +++ b/admin/unidata/Makefile.in @@ -1,6 +1,6 @@ ### @configure_input@ -# Copyright (C) 2012-2016 Free Software Foundation, Inc. +# Copyright (C) 2012-2017 Free Software Foundation, Inc. # Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010, 2011 # National Institute of Advanced Industrial Science and Technology (AIST) diff --git a/admin/unidata/blocks.awk b/admin/unidata/blocks.awk index bf9a942489..7845d02cdc 100755 --- a/admin/unidata/blocks.awk +++ b/admin/unidata/blocks.awk @@ -1,6 +1,6 @@ #!/usr/bin/awk -f -## Copyright (C) 2015-2016 Free Software Foundation, Inc. +## Copyright (C) 2015-2017 Free Software Foundation, Inc. ## Author: Glenn Morris diff --git a/admin/unidata/unidata-gen.el b/admin/unidata/unidata-gen.el index c03f549dac..3c5119a8a3 100644 --- a/admin/unidata/unidata-gen.el +++ b/admin/unidata/unidata-gen.el @@ -1,6 +1,6 @@ ;; unidata-gen.el -- Create files containing character property data. -;; Copyright (C) 2008-2016 Free Software Foundation, Inc. +;; Copyright (C) 2008-2017 Free Software Foundation, Inc. ;; Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010, 2011 ;; National Institute of Advanced Industrial Science and Technology (AIST) diff --git a/admin/unidata/uvs.el b/admin/unidata/uvs.el index bd03621905..0b7edc73c8 100644 --- a/admin/unidata/uvs.el +++ b/admin/unidata/uvs.el @@ -1,6 +1,6 @@ ;;; uvs.el --- utility for UVS (format 14) cmap subtables in OpenType fonts. -;; Copyright (C) 2014-2016 Free Software Foundation, Inc. +;; Copyright (C) 2014-2017 Free Software Foundation, Inc. ;; Author: YAMAMOTO Mitsuharu diff --git a/admin/update-copyright b/admin/update-copyright index 2f6dc11e93..4da327bd9c 100755 --- a/admin/update-copyright +++ b/admin/update-copyright @@ -7,7 +7,7 @@ # By default, this script uses the local-time calendar year. # Set the UPDATE_COPYRIGHT_YEAR environment variable to override the default. -# Copyright 2013-2016 Free Software Foundation, Inc. +# Copyright 2013-2017 Free Software Foundation, Inc. # This file is part of GNU Emacs. diff --git a/admin/update_autogen b/admin/update_autogen index 82ad622c64..86054aef9f 100755 --- a/admin/update_autogen +++ b/admin/update_autogen @@ -1,7 +1,7 @@ #!/usr/bin/env bash ### update_autogen - update some auto-generated files in the Emacs tree -## Copyright (C) 2011-2016 Free Software Foundation, Inc. +## Copyright (C) 2011-2017 Free Software Foundation, Inc. ## Author: Glenn Morris diff --git a/autogen.sh b/autogen.sh index a63c53c903..3897444ab5 100755 --- a/autogen.sh +++ b/autogen.sh @@ -1,7 +1,7 @@ #!/bin/sh ### autogen.sh - tool to help build Emacs from a repository checkout -## Copyright (C) 2011-2016 Free Software Foundation, Inc. +## Copyright (C) 2011-2017 Free Software Foundation, Inc. ## Author: Glenn Morris ## Maintainer: emacs-devel@gnu.org diff --git a/build-aux/git-hooks/commit-msg b/build-aux/git-hooks/commit-msg index 52f92257d4..475956e551 100755 --- a/build-aux/git-hooks/commit-msg +++ b/build-aux/git-hooks/commit-msg @@ -1,7 +1,7 @@ #!/bin/sh # Check the format of GNU Emacs change log entries. -# Copyright 2014-2016 Free Software Foundation, Inc. +# Copyright 2014-2017 Free Software Foundation, Inc. # This file is part of GNU Emacs. diff --git a/build-aux/git-hooks/pre-commit b/build-aux/git-hooks/pre-commit index 5a512442b1..314c6e61b9 100755 --- a/build-aux/git-hooks/pre-commit +++ b/build-aux/git-hooks/pre-commit @@ -1,7 +1,7 @@ #!/bin/sh # Check file names in git commits for GNU Emacs. -# Copyright 2014-2016 Free Software Foundation, Inc. +# Copyright 2014-2017 Free Software Foundation, Inc. # This file is part of GNU Emacs. diff --git a/build-aux/gitlog-to-changelog b/build-aux/gitlog-to-changelog index 83bafdffa6..cf16425463 100755 --- a/build-aux/gitlog-to-changelog +++ b/build-aux/gitlog-to-changelog @@ -9,7 +9,7 @@ my $VERSION = '2016-03-22 21:49'; # UTC # If you change this file with Emacs, please let the write hook # do its job. Otherwise, update this string manually. -# Copyright (C) 2008-2016 Free Software Foundation, Inc. +# Copyright (C) 2008-2017 Free Software Foundation, Inc. # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by diff --git a/build-aux/gitlog-to-emacslog b/build-aux/gitlog-to-emacslog index 345c37f63d..2b5c9792d8 100755 --- a/build-aux/gitlog-to-emacslog +++ b/build-aux/gitlog-to-emacslog @@ -2,7 +2,7 @@ # Convert git log output to ChangeLog format for GNU Emacs. -# Copyright (C) 2014-2016 Free Software Foundation, Inc. +# Copyright (C) 2014-2017 Free Software Foundation, Inc. # Author: Paul Eggert diff --git a/build-aux/make-info-dir b/build-aux/make-info-dir index 3154812585..e8c66943e0 100755 --- a/build-aux/make-info-dir +++ b/build-aux/make-info-dir @@ -2,7 +2,7 @@ ### make-info-dir - create info/dir, for systems without install-info -## Copyright (C) 2013-2016 Free Software Foundation, Inc. +## Copyright (C) 2013-2017 Free Software Foundation, Inc. ## Author: Glenn Morris ## Maintainer: emacs-devel@gnu.org diff --git a/build-aux/move-if-change b/build-aux/move-if-change index e3fe71d18f..4dd8699592 100755 --- a/build-aux/move-if-change +++ b/build-aux/move-if-change @@ -8,7 +8,7 @@ VERSION='2016-01-11 22:04'; # UTC # If you change this file with Emacs, please let the write hook # do its job. Otherwise, update this string manually. -# Copyright (C) 2002-2016 Free Software Foundation, Inc. +# Copyright (C) 2002-2017 Free Software Foundation, Inc. # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by diff --git a/build-aux/msys-to-w32 b/build-aux/msys-to-w32 index 8b1c970b99..3f57478a9d 100755 --- a/build-aux/msys-to-w32 +++ b/build-aux/msys-to-w32 @@ -2,7 +2,7 @@ # Convert a MSYS path list to Windows-native format. # Status is zero if successful, nonzero otherwise. -# Copyright (C) 2013-2016 Free Software Foundation, Inc. +# Copyright (C) 2013-2017 Free Software Foundation, Inc. # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by diff --git a/build-aux/snippet/arg-nonnull.h b/build-aux/snippet/arg-nonnull.h index 584649f694..1e62cc8982 100644 --- a/build-aux/snippet/arg-nonnull.h +++ b/build-aux/snippet/arg-nonnull.h @@ -1,5 +1,5 @@ /* A C macro for declaring that specific arguments must not be NULL. - Copyright (C) 2009-2016 Free Software Foundation, Inc. + Copyright (C) 2009-2017 Free Software Foundation, Inc. This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published diff --git a/build-aux/snippet/c++defs.h b/build-aux/snippet/c++defs.h index 813f2e2e4e..72df2bca6d 100644 --- a/build-aux/snippet/c++defs.h +++ b/build-aux/snippet/c++defs.h @@ -1,5 +1,5 @@ /* C++ compatible function declaration macros. - Copyright (C) 2010-2016 Free Software Foundation, Inc. + Copyright (C) 2010-2017 Free Software Foundation, Inc. This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published diff --git a/build-aux/snippet/warn-on-use.h b/build-aux/snippet/warn-on-use.h index 2948b47882..3c0eb579fa 100644 --- a/build-aux/snippet/warn-on-use.h +++ b/build-aux/snippet/warn-on-use.h @@ -1,5 +1,5 @@ /* A C macro for emitting warnings if a function is used. - Copyright (C) 2010-2016 Free Software Foundation, Inc. + Copyright (C) 2010-2017 Free Software Foundation, Inc. This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published diff --git a/build-aux/update-copyright b/build-aux/update-copyright index 17ee6b14d1..2d20d211c9 100755 --- a/build-aux/update-copyright +++ b/build-aux/update-copyright @@ -5,7 +5,7 @@ eval '(exit $?0)' && eval 'exec perl -wS -0777 -pi "$0" "$@"' my $VERSION = '2016-01-12.23:13'; # UTC -# Copyright (C) 2009-2016 Free Software Foundation, Inc. +# Copyright (C) 2009-2017 Free Software Foundation, Inc. # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by diff --git a/build-aux/update-subdirs b/build-aux/update-subdirs index 6b7d0bd533..90f1b3c0c6 100755 --- a/build-aux/update-subdirs +++ b/build-aux/update-subdirs @@ -1,7 +1,7 @@ #!/bin/sh # Write into $1/subdirs.el a list of subdirs of directory $1. -# Copyright (C) 1994-1995, 1997, 1999, 2001-2016 Free Software +# Copyright (C) 1994-1995, 1997, 1999, 2001-2017 Free Software # Foundation, Inc. # This file is part of GNU Emacs. diff --git a/configure.ac b/configure.ac index 8a5842c42a..4d9ed93a44 100644 --- a/configure.ac +++ b/configure.ac @@ -4,7 +4,7 @@ dnl autoconf dnl in the directory containing this script. dnl If you changed any AC_DEFINES, also run autoheader. dnl -dnl Copyright (C) 1994-1996, 1999-2016 Free Software Foundation, Inc. +dnl Copyright (C) 1994-1996, 1999-2017 Free Software Foundation, Inc. dnl dnl This file is part of GNU Emacs. dnl diff --git a/doc/emacs/ChangeLog.1 b/doc/emacs/ChangeLog.1 index 3f746ebd76..3c7aeb0c1d 100644 --- a/doc/emacs/ChangeLog.1 +++ b/doc/emacs/ChangeLog.1 @@ -10919,7 +10919,7 @@ ;; coding: utf-8 ;; End: - Copyright (C) 1993-1999, 2001-2016 Free Software Foundation, Inc. + Copyright (C) 1993-1999, 2001-2017 Free Software Foundation, Inc. This file is part of GNU Emacs. diff --git a/doc/emacs/Makefile.in b/doc/emacs/Makefile.in index aeb80a8a04..ffcc4baafd 100644 --- a/doc/emacs/Makefile.in +++ b/doc/emacs/Makefile.in @@ -1,6 +1,6 @@ ### @configure_input@ -# Copyright (C) 1994, 1996-2016 Free Software Foundation, Inc. +# Copyright (C) 1994, 1996-2017 Free Software Foundation, Inc. # This file is part of GNU Emacs. diff --git a/doc/emacs/abbrevs.texi b/doc/emacs/abbrevs.texi index 227fe6f7ee..8cb7a4838e 100644 --- a/doc/emacs/abbrevs.texi +++ b/doc/emacs/abbrevs.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2016 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2017 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @node Abbrevs diff --git a/doc/emacs/ack.texi b/doc/emacs/ack.texi index 6a0a289e1d..1ebe852a3c 100644 --- a/doc/emacs/ack.texi +++ b/doc/emacs/ack.texi @@ -1,6 +1,6 @@ @c -*- coding: utf-8 -*- @c This is part of the Emacs manual. -@c Copyright (C) 1994-1997, 1999-2016 Free Software Foundation, Inc. +@c Copyright (C) 1994-1997, 1999-2017 Free Software Foundation, Inc. @c See file emacs.texi for copying conditions. @c @node Acknowledgments diff --git a/doc/emacs/anti.texi b/doc/emacs/anti.texi index 68a65a7c0c..87cbe439e0 100644 --- a/doc/emacs/anti.texi +++ b/doc/emacs/anti.texi @@ -1,6 +1,6 @@ @c -*- coding: utf-8 -*- @c This is part of the Emacs manual. -@c Copyright (C) 2005-2016 Free Software Foundation, Inc. +@c Copyright (C) 2005-2017 Free Software Foundation, Inc. @c See file emacs.texi for copying conditions. @node Antinews diff --git a/doc/emacs/arevert-xtra.texi b/doc/emacs/arevert-xtra.texi index 7b0b6d2f63..936930e3b9 100644 --- a/doc/emacs/arevert-xtra.texi +++ b/doc/emacs/arevert-xtra.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 2004-2016 Free Software Foundation, Inc. +@c Copyright (C) 2004-2017 Free Software Foundation, Inc. @c See file emacs.texi for copying conditions. @c @c This file is included either in emacs-xtra.texi (when producing the diff --git a/doc/emacs/basic.texi b/doc/emacs/basic.texi index b6939be490..6b66c18016 100644 --- a/doc/emacs/basic.texi +++ b/doc/emacs/basic.texi @@ -1,6 +1,6 @@ @c -*- coding: utf-8 -*- @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2016 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2017 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @node Basic diff --git a/doc/emacs/buffers.texi b/doc/emacs/buffers.texi index 2eb837f151..1494a7d1e4 100644 --- a/doc/emacs/buffers.texi +++ b/doc/emacs/buffers.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2016 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2017 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @node Buffers diff --git a/doc/emacs/building.texi b/doc/emacs/building.texi index df0764ee6b..cab29f3491 100644 --- a/doc/emacs/building.texi +++ b/doc/emacs/building.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2016 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2017 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @node Building diff --git a/doc/emacs/cal-xtra.texi b/doc/emacs/cal-xtra.texi index 2dff8c9b86..f6bcb852ad 100644 --- a/doc/emacs/cal-xtra.texi +++ b/doc/emacs/cal-xtra.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -*- coding: utf-8 -*- -@c Copyright (C) 2004-2016 Free Software Foundation, Inc. +@c Copyright (C) 2004-2017 Free Software Foundation, Inc. @c See file emacs.texi for copying conditions. @c @c This file is included either in emacs-xtra.texi (when producing the diff --git a/doc/emacs/calendar.texi b/doc/emacs/calendar.texi index 60d323be84..679bcb454f 100644 --- a/doc/emacs/calendar.texi +++ b/doc/emacs/calendar.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -*- coding: utf-8 -*- -@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2016 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2017 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @node Calendar/Diary diff --git a/doc/emacs/cmdargs.texi b/doc/emacs/cmdargs.texi index 8db2ea12c8..7b07b50042 100644 --- a/doc/emacs/cmdargs.texi +++ b/doc/emacs/cmdargs.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2016 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2017 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @node Emacs Invocation diff --git a/doc/emacs/commands.texi b/doc/emacs/commands.texi index cf5ce1459c..143b075f4f 100644 --- a/doc/emacs/commands.texi +++ b/doc/emacs/commands.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2016 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2017 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @iftex diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi index 771633623f..51992ea028 100644 --- a/doc/emacs/custom.texi +++ b/doc/emacs/custom.texi @@ -1,6 +1,6 @@ @c -*- coding: utf-8 -*- @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2016 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2017 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @node Customization diff --git a/doc/emacs/dired-xtra.texi b/doc/emacs/dired-xtra.texi index e91aa8ce16..b1a587d42d 100644 --- a/doc/emacs/dired-xtra.texi +++ b/doc/emacs/dired-xtra.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 2004-2016 Free Software Foundation, Inc. +@c Copyright (C) 2004-2017 Free Software Foundation, Inc. @c See file emacs.texi for copying conditions. @c @c This file is included either in emacs-xtra.texi (when producing the diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi index 1b10ebc875..0e62a9ef94 100644 --- a/doc/emacs/dired.texi +++ b/doc/emacs/dired.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2016 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2017 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @node Dired diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi index 391e1a0ed5..1a9c65a08c 100644 --- a/doc/emacs/display.texi +++ b/doc/emacs/display.texi @@ -1,6 +1,6 @@ @c -*- coding: utf-8 -*- @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2016 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2017 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. diff --git a/doc/emacs/emerge-xtra.texi b/doc/emacs/emerge-xtra.texi index d56fbaee73..683822b6db 100644 --- a/doc/emacs/emerge-xtra.texi +++ b/doc/emacs/emerge-xtra.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 2004-2016 Free Software Foundation, Inc. +@c Copyright (C) 2004-2017 Free Software Foundation, Inc. @c See file emacs.texi for copying conditions. @c @c This file is included either in emacs-xtra.texi (when producing the diff --git a/doc/emacs/entering.texi b/doc/emacs/entering.texi index d6cb3cb8b0..ed1858f282 100644 --- a/doc/emacs/entering.texi +++ b/doc/emacs/entering.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 2001-2016 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 2001-2017 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @iftex diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi index 264154be66..47f92812be 100644 --- a/doc/emacs/files.texi +++ b/doc/emacs/files.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 1997, 1999-2016 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 1999-2017 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @node Files diff --git a/doc/emacs/fixit.texi b/doc/emacs/fixit.texi index 584efc6811..2ba3e26c48 100644 --- a/doc/emacs/fixit.texi +++ b/doc/emacs/fixit.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2016 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2017 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @node Fixit diff --git a/doc/emacs/fortran-xtra.texi b/doc/emacs/fortran-xtra.texi index 5763c9f379..1125942687 100644 --- a/doc/emacs/fortran-xtra.texi +++ b/doc/emacs/fortran-xtra.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 2004-2016 Free Software Foundation, Inc. +@c Copyright (C) 2004-2017 Free Software Foundation, Inc. @c See file emacs.texi for copying conditions. @c @c This file is included either in emacs-xtra.texi (when producing the diff --git a/doc/emacs/frames.texi b/doc/emacs/frames.texi index 99926dc47b..1611bd18f3 100644 --- a/doc/emacs/frames.texi +++ b/doc/emacs/frames.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 1997, 1999-2016 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 1999-2017 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @node Frames diff --git a/doc/emacs/glossary.texi b/doc/emacs/glossary.texi index bce97dacee..09b5bc3a24 100644 --- a/doc/emacs/glossary.texi +++ b/doc/emacs/glossary.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2016 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2017 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @node Glossary diff --git a/doc/emacs/gnu.texi b/doc/emacs/gnu.texi index 282d24d5bb..78f5354437 100644 --- a/doc/emacs/gnu.texi +++ b/doc/emacs/gnu.texi @@ -1,4 +1,4 @@ -@c Copyright (C) 1985-1987, 1993, 1995, 2001-2016 Free Software +@c Copyright (C) 1985-1987, 1993, 1995, 2001-2017 Free Software @c Foundation, Inc. @c @c Permission is granted to anyone to make or distribute verbatim copies diff --git a/doc/emacs/help.texi b/doc/emacs/help.texi index 64da890717..548ca6a1b4 100644 --- a/doc/emacs/help.texi +++ b/doc/emacs/help.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2016 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2017 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @node Help diff --git a/doc/emacs/indent.texi b/doc/emacs/indent.texi index f9f231d762..24a817fd67 100644 --- a/doc/emacs/indent.texi +++ b/doc/emacs/indent.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2016 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2017 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @node Indentation diff --git a/doc/emacs/killing.texi b/doc/emacs/killing.texi index 107adb99ec..47de053129 100644 --- a/doc/emacs/killing.texi +++ b/doc/emacs/killing.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2016 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2017 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. diff --git a/doc/emacs/kmacro.texi b/doc/emacs/kmacro.texi index a6344c049c..6c3e4212e0 100644 --- a/doc/emacs/kmacro.texi +++ b/doc/emacs/kmacro.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2016 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2017 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @node Keyboard Macros diff --git a/doc/emacs/m-x.texi b/doc/emacs/m-x.texi index 9e5f50b5e9..9d83a31af9 100644 --- a/doc/emacs/m-x.texi +++ b/doc/emacs/m-x.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2016 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2017 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @node M-x diff --git a/doc/emacs/macos.texi b/doc/emacs/macos.texi index 6e6520b60b..134646ccaa 100644 --- a/doc/emacs/macos.texi +++ b/doc/emacs/macos.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 2000-2016 Free Software Foundation, Inc. +@c Copyright (C) 2000-2017 Free Software Foundation, Inc. @c See file emacs.texi for copying conditions. @node Mac OS / GNUstep @appendix Emacs and Mac OS / GNUstep diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index acb6b8c803..281fa14a40 100644 --- a/doc/emacs/maintaining.texi +++ b/doc/emacs/maintaining.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual., Abbrevs, This is part of the Emacs manual., Top -@c Copyright (C) 1985-1987, 1993-1995, 1997, 1999-2016 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 1999-2017 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @node Maintaining diff --git a/doc/emacs/mark.texi b/doc/emacs/mark.texi index fdba0a4746..1e160508e5 100644 --- a/doc/emacs/mark.texi +++ b/doc/emacs/mark.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2016 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2017 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @node Mark diff --git a/doc/emacs/mini.texi b/doc/emacs/mini.texi index 7c97e42571..83e7f3b7eb 100644 --- a/doc/emacs/mini.texi +++ b/doc/emacs/mini.texi @@ -1,6 +1,6 @@ @c -*- coding: utf-8 -*- @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2016 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2017 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @node Minibuffer diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index a1f611cfb2..63db779bca 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2016 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2017 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @iftex diff --git a/doc/emacs/modes.texi b/doc/emacs/modes.texi index 63e31ab568..0acb82dc91 100644 --- a/doc/emacs/modes.texi +++ b/doc/emacs/modes.texi @@ -1,6 +1,6 @@ @c -*- coding: utf-8 -*- @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2016 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2017 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @node Modes diff --git a/doc/emacs/msdos-xtra.texi b/doc/emacs/msdos-xtra.texi index 89c14d2391..4ac734ed3d 100644 --- a/doc/emacs/msdos-xtra.texi +++ b/doc/emacs/msdos-xtra.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 2004-2016 Free Software Foundation, Inc. +@c Copyright (C) 2004-2017 Free Software Foundation, Inc. @c See file emacs.texi for copying conditions. @c @c This file is included either in emacs-xtra.texi (when producing the diff --git a/doc/emacs/msdos.texi b/doc/emacs/msdos.texi index d0e9ab45c2..bafb2c813c 100644 --- a/doc/emacs/msdos.texi +++ b/doc/emacs/msdos.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2016 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2017 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @node Microsoft Windows diff --git a/doc/emacs/mule.texi b/doc/emacs/mule.texi index a0925747ff..76bc945fb2 100644 --- a/doc/emacs/mule.texi +++ b/doc/emacs/mule.texi @@ -1,6 +1,6 @@ @c -*- coding: utf-8 -*- @c This is part of the Emacs manual. -@c Copyright (C) 1997, 1999-2016 Free Software Foundation, Inc. +@c Copyright (C) 1997, 1999-2017 Free Software Foundation, Inc. @c See file emacs.texi for copying conditions. @node International @chapter International Character Set Support diff --git a/doc/emacs/package.texi b/doc/emacs/package.texi index 5662c857de..d6f88aaec3 100644 --- a/doc/emacs/package.texi +++ b/doc/emacs/package.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2016 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2017 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @node Packages diff --git a/doc/emacs/picture-xtra.texi b/doc/emacs/picture-xtra.texi index b7d3cb3450..c3ea77c349 100644 --- a/doc/emacs/picture-xtra.texi +++ b/doc/emacs/picture-xtra.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 2004-2016 Free Software Foundation, Inc. +@c Copyright (C) 2004-2017 Free Software Foundation, Inc. @c See file emacs.texi for copying conditions. @c @c This file is included either in emacs-xtra.texi (when producing the diff --git a/doc/emacs/programs.texi b/doc/emacs/programs.texi index 3c80228120..97751aa2fa 100644 --- a/doc/emacs/programs.texi +++ b/doc/emacs/programs.texi @@ -1,6 +1,6 @@ @c -*- coding: utf-8 -*- @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 1997, 1999-2016 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 1999-2017 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @node Programs diff --git a/doc/emacs/regs.texi b/doc/emacs/regs.texi index a62d2b6730..7369f6b05b 100644 --- a/doc/emacs/regs.texi +++ b/doc/emacs/regs.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2016 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2017 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @node Registers diff --git a/doc/emacs/rmail.texi b/doc/emacs/rmail.texi index 84f1296484..d46398281f 100644 --- a/doc/emacs/rmail.texi +++ b/doc/emacs/rmail.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2016 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2017 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @node Rmail diff --git a/doc/emacs/screen.texi b/doc/emacs/screen.texi index 46ccca52aa..6b9795834c 100644 --- a/doc/emacs/screen.texi +++ b/doc/emacs/screen.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2016 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2017 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @node Screen diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi index 543d547004..b728258973 100644 --- a/doc/emacs/search.texi +++ b/doc/emacs/search.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2016 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2017 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @node Search diff --git a/doc/emacs/sending.texi b/doc/emacs/sending.texi index 30b8491e27..5cc09eb9df 100644 --- a/doc/emacs/sending.texi +++ b/doc/emacs/sending.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2016 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2017 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @node Sending Mail diff --git a/doc/emacs/text.texi b/doc/emacs/text.texi index f28488e454..f06a0c8342 100644 --- a/doc/emacs/text.texi +++ b/doc/emacs/text.texi @@ -1,6 +1,6 @@ @c -*- coding: utf-8 -*- @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2016 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2017 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @node Text diff --git a/doc/emacs/trouble.texi b/doc/emacs/trouble.texi index 7a5defabf0..a742c50e0d 100644 --- a/doc/emacs/trouble.texi +++ b/doc/emacs/trouble.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2016 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2017 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @iftex diff --git a/doc/emacs/vc-xtra.texi b/doc/emacs/vc-xtra.texi index abd29fd657..538aeeeb53 100644 --- a/doc/emacs/vc-xtra.texi +++ b/doc/emacs/vc-xtra.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 2004-2016 Free Software Foundation, Inc. +@c Copyright (C) 2004-2017 Free Software Foundation, Inc. @c See file emacs.texi for copying conditions. @c @c This file is included in emacs-xtra.texi when producing the printed diff --git a/doc/emacs/vc1-xtra.texi b/doc/emacs/vc1-xtra.texi index 9cbe4b544f..8e5c5d5b61 100644 --- a/doc/emacs/vc1-xtra.texi +++ b/doc/emacs/vc1-xtra.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 2004-2016 Free Software Foundation, Inc. +@c Copyright (C) 2004-2017 Free Software Foundation, Inc. @c See file emacs.texi for copying conditions. @c @c This file is included either in vc-xtra.texi (when producing the diff --git a/doc/emacs/windows.texi b/doc/emacs/windows.texi index bb8b68bf5f..65454edf83 100644 --- a/doc/emacs/windows.texi +++ b/doc/emacs/windows.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2016 Free Software +@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2017 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @node Windows diff --git a/doc/emacs/xresources.texi b/doc/emacs/xresources.texi index 61fdb0a4fd..7e27ddd1d9 100644 --- a/doc/emacs/xresources.texi +++ b/doc/emacs/xresources.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 1987, 1993-1995, 1997, 2001-2016 Free Software +@c Copyright (C) 1987, 1993-1995, 1997, 2001-2017 Free Software @c Foundation, Inc. @c See file emacs.texi for copying conditions. @node X Resources diff --git a/doc/lispintro/ChangeLog.1 b/doc/lispintro/ChangeLog.1 index d00f2885ab..7e5b629164 100644 --- a/doc/lispintro/ChangeLog.1 +++ b/doc/lispintro/ChangeLog.1 @@ -782,7 +782,7 @@ ;; coding: utf-8 ;; End: - Copyright (C) 2001-2016 Free Software Foundation, Inc. + Copyright (C) 2001-2017 Free Software Foundation, Inc. This file is part of GNU Emacs. diff --git a/doc/lispintro/Makefile.in b/doc/lispintro/Makefile.in index 58ebd81a70..d8e203fd06 100644 --- a/doc/lispintro/Makefile.in +++ b/doc/lispintro/Makefile.in @@ -1,6 +1,6 @@ ### @configure_input@ -# Copyright (C) 1994-1999, 2001-2016 Free Software Foundation, Inc. +# Copyright (C) 1994-1999, 2001-2017 Free Software Foundation, Inc. # This file is part of GNU Emacs. diff --git a/doc/lispintro/README b/doc/lispintro/README index aa7d07c178..f8134fce80 100644 --- a/doc/lispintro/README +++ b/doc/lispintro/README @@ -1,4 +1,4 @@ -Copyright (C) 2001-2016 Free Software Foundation, Inc. +Copyright (C) 2001-2017 Free Software Foundation, Inc. See the end of the file for license conditions. diff --git a/doc/lispintro/cons-1.eps b/doc/lispintro/cons-1.eps index 1dc7aa7247..1d4e78cb73 100644 --- a/doc/lispintro/cons-1.eps +++ b/doc/lispintro/cons-1.eps @@ -4,7 +4,7 @@ %%CreationDate: Wed Mar 8 14:26:58 1995 %%Creator: Tgif-2.16-p4 by William Chia-Wei Cheng (william@cs.UCLA.edu) -% Copyright (C) 1995, 1997, 2001-2016 Free Software Foundation, Inc. +% Copyright (C) 1995, 1997, 2001-2017 Free Software Foundation, Inc. % % This file is part of GNU Emacs. % diff --git a/doc/lispintro/cons-2.eps b/doc/lispintro/cons-2.eps index fbb13f22b7..af59a0fd7d 100644 --- a/doc/lispintro/cons-2.eps +++ b/doc/lispintro/cons-2.eps @@ -4,7 +4,7 @@ %%CreationDate: Wed Mar 8 14:26:39 1995 %%Creator: Tgif-2.16-p4 by William Chia-Wei Cheng (william@cs.UCLA.edu) -% Copyright (C) 1995, 1997, 2001-2016 Free Software Foundation, Inc. +% Copyright (C) 1995, 1997, 2001-2017 Free Software Foundation, Inc. % % This file is part of GNU Emacs. % diff --git a/doc/lispintro/cons-2a.eps b/doc/lispintro/cons-2a.eps index b91ea1711e..2edcc21beb 100644 --- a/doc/lispintro/cons-2a.eps +++ b/doc/lispintro/cons-2a.eps @@ -4,7 +4,7 @@ %%CreationDate: Tue Mar 14 15:09:30 1995 %%Creator: Tgif-2.16-p4 by William Chia-Wei Cheng (william@cs.UCLA.edu) -% Copyright (C) 1995, 1997, 2001-2016 Free Software Foundation, Inc. +% Copyright (C) 1995, 1997, 2001-2017 Free Software Foundation, Inc. % % This file is part of GNU Emacs. % diff --git a/doc/lispintro/cons-3.eps b/doc/lispintro/cons-3.eps index 349a941eee..f7e37f16f9 100644 --- a/doc/lispintro/cons-3.eps +++ b/doc/lispintro/cons-3.eps @@ -4,7 +4,7 @@ %%CreationDate: Wed Mar 8 14:25:41 1995 %%Creator: Tgif-2.16-p4 by William Chia-Wei Cheng (william@cs.UCLA.edu) -% Copyright (C) 1995, 1997, 2001-2016 Free Software Foundation, Inc. +% Copyright (C) 1995, 1997, 2001-2017 Free Software Foundation, Inc. % % This file is part of GNU Emacs. % diff --git a/doc/lispintro/cons-4.eps b/doc/lispintro/cons-4.eps index c6e2d44512..f9549b9511 100644 --- a/doc/lispintro/cons-4.eps +++ b/doc/lispintro/cons-4.eps @@ -4,7 +4,7 @@ %%CreationDate: Wed Mar 8 14:25:06 1995 %%Creator: Tgif-2.16-p4 by William Chia-Wei Cheng (william@cs.UCLA.edu) -% Copyright (C) 1995, 1997, 2001-2016 Free Software Foundation, Inc. +% Copyright (C) 1995, 1997, 2001-2017 Free Software Foundation, Inc. % % This file is part of GNU Emacs. % diff --git a/doc/lispintro/cons-5.eps b/doc/lispintro/cons-5.eps index 7421a5d31e..83f14df6d2 100644 --- a/doc/lispintro/cons-5.eps +++ b/doc/lispintro/cons-5.eps @@ -4,7 +4,7 @@ %%CreationDate: Wed Mar 8 14:27:28 1995 %%Creator: Tgif-2.16-p4 by William Chia-Wei Cheng (william@cs.UCLA.edu) -% Copyright (C) 1995, 1997, 2001-2016 Free Software Foundation, Inc. +% Copyright (C) 1995, 1997, 2001-2017 Free Software Foundation, Inc. % % This file is part of GNU Emacs. % diff --git a/doc/lispintro/drawers.eps b/doc/lispintro/drawers.eps index 3acf54e0dc..b9efdceb55 100644 --- a/doc/lispintro/drawers.eps +++ b/doc/lispintro/drawers.eps @@ -9,7 +9,7 @@ %%EndComments %%BeginProlog -% Copyright (C) 2001-2016 Free Software Foundation, Inc. +% Copyright (C) 2001-2017 Free Software Foundation, Inc. % % This file is part of GNU Emacs. % diff --git a/doc/lispintro/lambda-1.eps b/doc/lispintro/lambda-1.eps index fb9e41b67e..47370b24b9 100644 --- a/doc/lispintro/lambda-1.eps +++ b/doc/lispintro/lambda-1.eps @@ -4,7 +4,7 @@ %%CreationDate: Wed Mar 8 14:31:53 1995 %%Creator: Tgif-2.16-p4 by William Chia-Wei Cheng (william@cs.UCLA.edu) -% Copyright (C) 1995, 1997, 2001-2016 Free Software Foundation, Inc. +% Copyright (C) 1995, 1997, 2001-2017 Free Software Foundation, Inc. % % This file is part of GNU Emacs. % diff --git a/doc/lispintro/lambda-2.eps b/doc/lispintro/lambda-2.eps index 4aa38dfb45..804dbfbd6f 100644 --- a/doc/lispintro/lambda-2.eps +++ b/doc/lispintro/lambda-2.eps @@ -4,7 +4,7 @@ %%CreationDate: Wed Mar 8 14:33:09 1995 %%Creator: Tgif-2.16-p4 by William Chia-Wei Cheng (william@cs.UCLA.edu) -% Copyright (C) 1995, 1997, 2001-2016 Free Software Foundation, Inc. +% Copyright (C) 1995, 1997, 2001-2017 Free Software Foundation, Inc. % % This file is part of GNU Emacs. % diff --git a/doc/lispintro/lambda-3.eps b/doc/lispintro/lambda-3.eps index 0612eb3000..95610f692f 100644 --- a/doc/lispintro/lambda-3.eps +++ b/doc/lispintro/lambda-3.eps @@ -4,7 +4,7 @@ %%CreationDate: Wed Mar 8 14:33:49 1995 %%Creator: Tgif-2.16-p4 by William Chia-Wei Cheng (william@cs.UCLA.edu) -% Copyright (C) 1995, 1997, 2001-2016 Free Software Foundation, Inc. +% Copyright (C) 1995, 1997, 2001-2017 Free Software Foundation, Inc. % % This file is part of GNU Emacs. % diff --git a/doc/lispref/ChangeLog.1 b/doc/lispref/ChangeLog.1 index 610e7541e7..6ce0065b93 100644 --- a/doc/lispref/ChangeLog.1 +++ b/doc/lispref/ChangeLog.1 @@ -13989,7 +13989,7 @@ ;; coding: utf-8 ;; End: - Copyright (C) 1998-2016 Free Software Foundation, Inc. + Copyright (C) 1998-2017 Free Software Foundation, Inc. This file is part of GNU Emacs. diff --git a/doc/lispref/Makefile.in b/doc/lispref/Makefile.in index 7aadee7ade..724ac93cd3 100644 --- a/doc/lispref/Makefile.in +++ b/doc/lispref/Makefile.in @@ -1,6 +1,6 @@ ### @configure_input@ -# Copyright (C) 1990-1996, 1998-2016 Free Software Foundation, Inc. +# Copyright (C) 1990-1996, 1998-2017 Free Software Foundation, Inc. # This file is part of GNU Emacs. diff --git a/doc/lispref/README b/doc/lispref/README index c7dced892e..fbc3169cee 100644 --- a/doc/lispref/README +++ b/doc/lispref/README @@ -1,4 +1,4 @@ -Copyright (C) 2001-2016 Free Software Foundation, Inc. -*- outline -*- +Copyright (C) 2001-2017 Free Software Foundation, Inc. -*- outline -*- See the end of the file for license conditions. diff --git a/doc/lispref/abbrevs.texi b/doc/lispref/abbrevs.texi index cdea2a8b3c..dfcb173092 100644 --- a/doc/lispref/abbrevs.texi +++ b/doc/lispref/abbrevs.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1994, 1999, 2001-2016 Free Software Foundation, +@c Copyright (C) 1990-1994, 1999, 2001-2017 Free Software Foundation, @c Inc. @c See the file elisp.texi for copying conditions. @node Abbrevs diff --git a/doc/lispref/anti.texi b/doc/lispref/anti.texi index 17d765de14..02d08ebc01 100644 --- a/doc/lispref/anti.texi +++ b/doc/lispref/anti.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1999, 2002-2016 Free Software Foundation, Inc. +@c Copyright (C) 1999, 2002-2017 Free Software Foundation, Inc. @c See the file elisp.texi for copying conditions. @c This node must have no pointers. diff --git a/doc/lispref/back.texi b/doc/lispref/back.texi index ecd9c615be..9fc5faa6c2 100644 --- a/doc/lispref/back.texi +++ b/doc/lispref/back.texi @@ -1,6 +1,6 @@ \input texinfo @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 2001-2016 Free Software Foundation, Inc. +@c Copyright (C) 2001-2017 Free Software Foundation, Inc. @c See the file elisp.texi for copying conditions. @c @c %**start of header diff --git a/doc/lispref/backups.texi b/doc/lispref/backups.texi index b9e6466c87..83d826018c 100644 --- a/doc/lispref/backups.texi +++ b/doc/lispref/backups.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1995, 1999, 2001-2016 Free Software Foundation, +@c Copyright (C) 1990-1995, 1999, 2001-2017 Free Software Foundation, @c Inc. @c See the file elisp.texi for copying conditions. @node Backups and Auto-Saving diff --git a/doc/lispref/buffers.texi b/doc/lispref/buffers.texi index 740d7cfd8a..c1b0d8c1a9 100644 --- a/doc/lispref/buffers.texi +++ b/doc/lispref/buffers.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1995, 1998-1999, 2001-2016 Free Software +@c Copyright (C) 1990-1995, 1998-1999, 2001-2017 Free Software @c Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Buffers diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index 6e83659f63..b2dc49391b 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1995, 1998-1999, 2001-2016 Free Software +@c Copyright (C) 1990-1995, 1998-1999, 2001-2017 Free Software @c Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Command Loop diff --git a/doc/lispref/compile.texi b/doc/lispref/compile.texi index f6cd0229c4..b1cc04be09 100644 --- a/doc/lispref/compile.texi +++ b/doc/lispref/compile.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1994, 2001-2016 Free Software Foundation, Inc. +@c Copyright (C) 1990-1994, 2001-2017 Free Software Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Byte Compilation @chapter Byte Compilation diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi index 947c54f9c3..401a999cf2 100644 --- a/doc/lispref/control.texi +++ b/doc/lispref/control.texi @@ -1,6 +1,6 @@ @c -*- mode: texinfo; coding: utf-8 -*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1995, 1998-1999, 2001-2016 Free Software +@c Copyright (C) 1990-1995, 1998-1999, 2001-2017 Free Software @c Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Control Structures diff --git a/doc/lispref/customize.texi b/doc/lispref/customize.texi index 4a6f7f2162..5372728466 100644 --- a/doc/lispref/customize.texi +++ b/doc/lispref/customize.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1997-2016 Free Software Foundation, Inc. +@c Copyright (C) 1997-2017 Free Software Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Customization @chapter Customization Settings diff --git a/doc/lispref/debugging.texi b/doc/lispref/debugging.texi index 371934377a..45db6406d3 100644 --- a/doc/lispref/debugging.texi +++ b/doc/lispref/debugging.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1994, 1998-1999, 2001-2016 Free Software +@c Copyright (C) 1990-1994, 1998-1999, 2001-2017 Free Software @c Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Debugging diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index fbdc574c65..b8599abd14 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -1,6 +1,6 @@ @c -*- mode: texinfo; coding: utf-8 -*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1995, 1998-2016 Free Software Foundation, Inc. +@c Copyright (C) 1990-1995, 1998-2017 Free Software Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Display @chapter Emacs Display diff --git a/doc/lispref/edebug.texi b/doc/lispref/edebug.texi index 47fe02a4a5..7e6743b17e 100644 --- a/doc/lispref/edebug.texi +++ b/doc/lispref/edebug.texi @@ -1,6 +1,6 @@ @comment -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1992-1994, 1998-1999, 2001-2016 Free Software +@c Copyright (C) 1992-1994, 1998-1999, 2001-2017 Free Software @c Foundation, Inc. @c See the file elisp.texi for copying conditions. diff --git a/doc/lispref/errors.texi b/doc/lispref/errors.texi index 03aea4ef44..84980da28e 100644 --- a/doc/lispref/errors.texi +++ b/doc/lispref/errors.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1993, 1999, 2001-2016 Free Software Foundation, +@c Copyright (C) 1990-1993, 1999, 2001-2017 Free Software Foundation, @c Inc. @c See the file elisp.texi for copying conditions. @node Standard Errors diff --git a/doc/lispref/eval.texi b/doc/lispref/eval.texi index d2a8ff56b6..363d0a1431 100644 --- a/doc/lispref/eval.texi +++ b/doc/lispref/eval.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1994, 1998, 2001-2016 Free Software Foundation, +@c Copyright (C) 1990-1994, 1998, 2001-2017 Free Software Foundation, @c Inc. @c See the file elisp.texi for copying conditions. @node Evaluation diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index 85c80d76f7..6f015e2d64 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1995, 1998-1999, 2001-2016 Free Software +@c Copyright (C) 1990-1995, 1998-1999, 2001-2017 Free Software @c Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Files diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index ec344c726c..d6f014fada 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1995, 1998-1999, 2001-2016 Free Software +@c Copyright (C) 1990-1995, 1998-1999, 2001-2017 Free Software @c Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Frames diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi index bc04beeebc..0d68781e33 100644 --- a/doc/lispref/functions.texi +++ b/doc/lispref/functions.texi @@ -1,6 +1,6 @@ @c -*- mode: texinfo; coding: utf-8 -*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1995, 1998-1999, 2001-2016 Free Software +@c Copyright (C) 1990-1995, 1998-1999, 2001-2017 Free Software @c Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Functions diff --git a/doc/lispref/hash.texi b/doc/lispref/hash.texi index 8389c21470..521050edbe 100644 --- a/doc/lispref/hash.texi +++ b/doc/lispref/hash.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1999, 2001-2016 Free Software Foundation, Inc. +@c Copyright (C) 1999, 2001-2017 Free Software Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Hash Tables @chapter Hash Tables diff --git a/doc/lispref/help.texi b/doc/lispref/help.texi index b945e438f5..82cd53fad2 100644 --- a/doc/lispref/help.texi +++ b/doc/lispref/help.texi @@ -1,6 +1,6 @@ @c -*- mode: texinfo; coding: utf-8 -*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1995, 1998-1999, 2001-2016 Free Software +@c Copyright (C) 1990-1995, 1998-1999, 2001-2017 Free Software @c Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Documentation diff --git a/doc/lispref/hooks.texi b/doc/lispref/hooks.texi index 1027aa0343..0ac5b08c87 100644 --- a/doc/lispref/hooks.texi +++ b/doc/lispref/hooks.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1993, 1998, 2001-2016 Free Software Foundation, +@c Copyright (C) 1990-1993, 1998, 2001-2017 Free Software Foundation, @c Inc. @c See the file elisp.texi for copying conditions. @node Standard Hooks diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi index 41064df5a2..955c5ca751 100644 --- a/doc/lispref/internals.texi +++ b/doc/lispref/internals.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1993, 1998-1999, 2001-2016 Free Software +@c Copyright (C) 1990-1993, 1998-1999, 2001-2017 Free Software @c Foundation, Inc. @c See the file elisp.texi for copying conditions. @node GNU Emacs Internals diff --git a/doc/lispref/intro.texi b/doc/lispref/intro.texi index 0f42d4d8a7..a4297e9830 100644 --- a/doc/lispref/intro.texi +++ b/doc/lispref/intro.texi @@ -1,6 +1,6 @@ @c -*-coding: utf-8-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1994, 2001-2016 Free Software Foundation, Inc. +@c Copyright (C) 1990-1994, 2001-2017 Free Software Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Introduction diff --git a/doc/lispref/keymaps.texi b/doc/lispref/keymaps.texi index 2641ad0b6a..a34b44f0cb 100644 --- a/doc/lispref/keymaps.texi +++ b/doc/lispref/keymaps.texi @@ -1,6 +1,6 @@ @c -*- mode: texinfo; coding: utf-8 -*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1994, 1998-2016 Free Software Foundation, Inc. +@c Copyright (C) 1990-1994, 1998-2017 Free Software Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Keymaps @chapter Keymaps diff --git a/doc/lispref/lay-flat.texi b/doc/lispref/lay-flat.texi index 42bc26637b..4adb03b898 100644 --- a/doc/lispref/lay-flat.texi +++ b/doc/lispref/lay-flat.texi @@ -1,6 +1,6 @@ \input texinfo @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 2001-2016 Free Software Foundation, Inc. +@c Copyright (C) 2001-2017 Free Software Foundation, Inc. @c See the file elisp.texi for copying conditions. @c @comment %**start of header diff --git a/doc/lispref/lists.texi b/doc/lispref/lists.texi index dc4075dbab..bd7d85aa18 100644 --- a/doc/lispref/lists.texi +++ b/doc/lispref/lists.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1995, 1998-1999, 2001-2016 Free Software +@c Copyright (C) 1990-1995, 1998-1999, 2001-2017 Free Software @c Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Lists diff --git a/doc/lispref/loading.texi b/doc/lispref/loading.texi index 1468603e50..fc4c8d9c35 100644 --- a/doc/lispref/loading.texi +++ b/doc/lispref/loading.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1995, 1998-1999, 2001-2016 Free Software +@c Copyright (C) 1990-1995, 1998-1999, 2001-2017 Free Software @c Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Loading diff --git a/doc/lispref/macros.texi b/doc/lispref/macros.texi index 6472bd1b03..5638dfaecf 100644 --- a/doc/lispref/macros.texi +++ b/doc/lispref/macros.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1995, 1998, 2001-2016 Free Software Foundation, +@c Copyright (C) 1990-1995, 1998, 2001-2017 Free Software Foundation, @c Inc. @c See the file elisp.texi for copying conditions. @node Macros diff --git a/doc/lispref/maps.texi b/doc/lispref/maps.texi index cf2c64844c..54d279e8ac 100644 --- a/doc/lispref/maps.texi +++ b/doc/lispref/maps.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1993, 1999, 2001-2016 Free Software Foundation, +@c Copyright (C) 1990-1993, 1999, 2001-2017 Free Software Foundation, @c Inc. @c See the file elisp.texi for copying conditions. @node Standard Keymaps diff --git a/doc/lispref/markers.texi b/doc/lispref/markers.texi index 1b4d74fb25..214b052537 100644 --- a/doc/lispref/markers.texi +++ b/doc/lispref/markers.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1995, 1998-1999, 2001-2016 Free Software +@c Copyright (C) 1990-1995, 1998-1999, 2001-2017 Free Software @c Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Markers diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi index 1fa2536db4..d256d4873b 100644 --- a/doc/lispref/minibuf.texi +++ b/doc/lispref/minibuf.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1995, 1998-1999, 2001-2016 Free Software +@c Copyright (C) 1990-1995, 1998-1999, 2001-2017 Free Software @c Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Minibuffers diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index 7bbb5e6f58..b24ab3603d 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1995, 1998-1999, 2001-2016 Free Software +@c Copyright (C) 1990-1995, 1998-1999, 2001-2017 Free Software @c Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Modes diff --git a/doc/lispref/nonascii.texi b/doc/lispref/nonascii.texi index e4581b3d68..ab8f2fc94f 100644 --- a/doc/lispref/nonascii.texi +++ b/doc/lispref/nonascii.texi @@ -1,6 +1,6 @@ @c -*- mode: texinfo; coding: utf-8 -*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1998-1999, 2001-2016 Free Software Foundation, Inc. +@c Copyright (C) 1998-1999, 2001-2017 Free Software Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Non-ASCII Characters @chapter Non-@acronym{ASCII} Characters diff --git a/doc/lispref/numbers.texi b/doc/lispref/numbers.texi index 28eb6b18af..deae5fd85d 100644 --- a/doc/lispref/numbers.texi +++ b/doc/lispref/numbers.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1995, 1998-1999, 2001-2016 Free Software +@c Copyright (C) 1990-1995, 1998-1999, 2001-2017 Free Software @c Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Numbers diff --git a/doc/lispref/objects.texi b/doc/lispref/objects.texi index 324593068d..79b7b27795 100644 --- a/doc/lispref/objects.texi +++ b/doc/lispref/objects.texi @@ -1,6 +1,6 @@ @c -*- mode: texinfo; coding: utf-8 -*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1995, 1998-1999, 2001-2016 Free Software +@c Copyright (C) 1990-1995, 1998-1999, 2001-2017 Free Software @c Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Lisp Data Types diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index 9fa27113d0..da8bfeeb2c 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1995, 1998-1999, 2001-2016 Free Software +@c Copyright (C) 1990-1995, 1998-1999, 2001-2017 Free Software @c Foundation, Inc. @c See the file elisp.texi for copying conditions. @node System Interface diff --git a/doc/lispref/package.texi b/doc/lispref/package.texi index 67fd45b9e3..6066ea9a93 100644 --- a/doc/lispref/package.texi +++ b/doc/lispref/package.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 2010-2016 Free Software Foundation, Inc. +@c Copyright (C) 2010-2017 Free Software Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Packaging @chapter Preparing Lisp code for distribution diff --git a/doc/lispref/positions.texi b/doc/lispref/positions.texi index b6133dc7e2..6770b79f2d 100644 --- a/doc/lispref/positions.texi +++ b/doc/lispref/positions.texi @@ -1,6 +1,6 @@ @c -*- mode: texinfo; coding: utf-8 -*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1995, 1998-2016 Free Software Foundation, Inc. +@c Copyright (C) 1990-1995, 1998-2017 Free Software Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Positions @chapter Positions diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi index 950dc9c6d4..2a79cc781f 100644 --- a/doc/lispref/processes.texi +++ b/doc/lispref/processes.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1995, 1998-1999, 2001-2016 Free Software +@c Copyright (C) 1990-1995, 1998-1999, 2001-2017 Free Software @c Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Processes diff --git a/doc/lispref/searching.texi b/doc/lispref/searching.texi index 579460f322..f3473c8db9 100644 --- a/doc/lispref/searching.texi +++ b/doc/lispref/searching.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1995, 1998-1999, 2001-2016 Free Software +@c Copyright (C) 1990-1995, 1998-1999, 2001-2017 Free Software @c Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Searching and Matching diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi index 920399586c..f8dcabb410 100644 --- a/doc/lispref/sequences.texi +++ b/doc/lispref/sequences.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1995, 1998-1999, 2001-2016 Free Software +@c Copyright (C) 1990-1995, 1998-1999, 2001-2017 Free Software @c Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Sequences Arrays Vectors diff --git a/doc/lispref/streams.texi b/doc/lispref/streams.texi index 41bc71e6ae..3e73e197d3 100644 --- a/doc/lispref/streams.texi +++ b/doc/lispref/streams.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1994, 1998-1999, 2001-2016 Free Software +@c Copyright (C) 1990-1994, 1998-1999, 2001-2017 Free Software @c Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Read and Print diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi index 3c764da4e2..d343bcf5ef 100644 --- a/doc/lispref/strings.texi +++ b/doc/lispref/strings.texi @@ -1,6 +1,6 @@ @c -*- mode: texinfo; coding: utf-8 -*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1995, 1998-1999, 2001-2016 Free Software +@c Copyright (C) 1990-1995, 1998-1999, 2001-2017 Free Software @c Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Strings and Characters diff --git a/doc/lispref/symbols.texi b/doc/lispref/symbols.texi index 36a2795d1d..e6ea8a1cc0 100644 --- a/doc/lispref/symbols.texi +++ b/doc/lispref/symbols.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1995, 1998-1999, 2001-2016 Free Software +@c Copyright (C) 1990-1995, 1998-1999, 2001-2017 Free Software @c Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Symbols diff --git a/doc/lispref/syntax.texi b/doc/lispref/syntax.texi index 19782d0fbd..0291f6c445 100644 --- a/doc/lispref/syntax.texi +++ b/doc/lispref/syntax.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1995, 1998-1999, 2001-2016 Free Software +@c Copyright (C) 1990-1995, 1998-1999, 2001-2017 Free Software @c Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Syntax Tables diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index b6635ddb0a..bfed6dd349 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1995, 1998-2016 Free Software Foundation, Inc. +@c Copyright (C) 1990-1995, 1998-2017 Free Software Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Text @chapter Text diff --git a/doc/lispref/tips.texi b/doc/lispref/tips.texi index 1ba9ad9701..ad8ac34a9c 100644 --- a/doc/lispref/tips.texi +++ b/doc/lispref/tips.texi @@ -1,6 +1,6 @@ @c -*- mode: texinfo; coding: utf-8 -*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1993, 1995, 1998-1999, 2001-2016 Free Software +@c Copyright (C) 1990-1993, 1995, 1998-1999, 2001-2017 Free Software @c Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Tips diff --git a/doc/lispref/two-volume-cross-refs.txt b/doc/lispref/two-volume-cross-refs.txt index 658ae153b4..78133e945f 100644 --- a/doc/lispref/two-volume-cross-refs.txt +++ b/doc/lispref/two-volume-cross-refs.txt @@ -1,4 +1,4 @@ -Copyright (C) 2001-2016 Free Software Foundation, Inc. +Copyright (C) 2001-2017 Free Software Foundation, Inc. See end for copying conditions. Two Volume Cross References diff --git a/doc/lispref/two-volume.make b/doc/lispref/two-volume.make index 5023f79b4e..a797750c0f 100644 --- a/doc/lispref/two-volume.make +++ b/doc/lispref/two-volume.make @@ -1,4 +1,4 @@ -# Copyright (C) 2007-2016 Free Software Foundation, Inc. +# Copyright (C) 2007-2017 Free Software Foundation, Inc. # See end for copying conditions. # although it would be nice to use tex rather than pdftex to avoid diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi index 887643196c..3a9ca558bb 100644 --- a/doc/lispref/variables.texi +++ b/doc/lispref/variables.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1995, 1998-2016 Free Software Foundation, Inc. +@c Copyright (C) 1990-1995, 1998-2017 Free Software Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Variables @chapter Variables diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index 042e0cc35b..d03e07e0a1 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990-1995, 1998-1999, 2001-2016 Free Software +@c Copyright (C) 1990-1995, 1998-1999, 2001-2017 Free Software @c Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Windows diff --git a/doc/man/ChangeLog.1 b/doc/man/ChangeLog.1 index d5a277111c..aa863ff72b 100644 --- a/doc/man/ChangeLog.1 +++ b/doc/man/ChangeLog.1 @@ -176,7 +176,7 @@ ;; coding: utf-8 ;; End: - Copyright (C) 2007-2016 Free Software Foundation, Inc. + Copyright (C) 2007-2017 Free Software Foundation, Inc. This file is part of GNU Emacs. diff --git a/doc/misc/ChangeLog.1 b/doc/misc/ChangeLog.1 index 93aacb521a..b3cb6a501a 100644 --- a/doc/misc/ChangeLog.1 +++ b/doc/misc/ChangeLog.1 @@ -12116,7 +12116,7 @@ ;; coding: utf-8 ;; End: - Copyright (C) 1993-1999, 2001-2016 Free Software Foundation, Inc. + Copyright (C) 1993-1999, 2001-2017 Free Software Foundation, Inc. This file is part of GNU Emacs. diff --git a/doc/misc/Makefile.in b/doc/misc/Makefile.in index 4dffeafb1d..741d56cd20 100644 --- a/doc/misc/Makefile.in +++ b/doc/misc/Makefile.in @@ -1,6 +1,6 @@ ### @configure_input@ -# Copyright (C) 1994, 1996-2016 Free Software Foundation, Inc. +# Copyright (C) 1994, 1996-2017 Free Software Foundation, Inc. # This file is part of GNU Emacs. diff --git a/doc/misc/efaq-w32.texi b/doc/misc/efaq-w32.texi index 28c09f6974..bb548c991c 100644 --- a/doc/misc/efaq-w32.texi +++ b/doc/misc/efaq-w32.texi @@ -15,7 +15,7 @@ Answers to Frequently asked Questions about using Emacs on Microsoft Windows. @include emacsver.texi @copying -Copyright @copyright{} 2008, 2010-2016 Free Software Foundation, Inc. +Copyright @copyright{} 2008, 2010-2017 Free Software Foundation, Inc. @quotation This list of frequently asked questions about GNU Emacs on MS Windows diff --git a/doc/misc/gnus-faq.texi b/doc/misc/gnus-faq.texi index 5a49f4ac32..6f5af94b34 100644 --- a/doc/misc/gnus-faq.texi +++ b/doc/misc/gnus-faq.texi @@ -1,7 +1,7 @@ @c \input texinfo @c -*-texinfo-*- @c Uncomment 1st line before texing this file alone. @c %**start of header -@c Copyright (C) 1995, 2001-2016 Free Software Foundation, Inc. +@c Copyright (C) 1995, 2001-2017 Free Software Foundation, Inc. @c @c @setfilename gnus-faq.info @c @settitle Frequently Asked Questions diff --git a/doc/misc/gnus-news.el b/doc/misc/gnus-news.el index 5ccd3f44be..8a77e38e15 100644 --- a/doc/misc/gnus-news.el +++ b/doc/misc/gnus-news.el @@ -1,5 +1,5 @@ ;;; gnus-news.el --- a hack to create GNUS-NEWS from texinfo source -;; Copyright (C) 2004-2016 Free Software Foundation, Inc. +;; Copyright (C) 2004-2017 Free Software Foundation, Inc. ;; Author: Reiner Steib ;; Keywords: tools diff --git a/doc/misc/gnus-news.texi b/doc/misc/gnus-news.texi index d1e83a7903..fc104104ed 100644 --- a/doc/misc/gnus-news.texi +++ b/doc/misc/gnus-news.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- -@c Copyright (C) 2004-2016 Free Software Foundation, Inc. +@c Copyright (C) 2004-2017 Free Software Foundation, Inc. @c Permission is granted to anyone to make or distribute verbatim copies @c of this document as received, in any medium, provided that the diff --git a/doc/misc/htmlfontify.texi b/doc/misc/htmlfontify.texi index 20cde7124d..a9741515c5 100644 --- a/doc/misc/htmlfontify.texi +++ b/doc/misc/htmlfontify.texi @@ -10,7 +10,7 @@ This manual documents Htmlfontify, a source code -> crosslinked + formatted + syntax colorized html transformer. -Copyright @copyright{} 2002-2003, 2013-2016 Free Software Foundation, +Copyright @copyright{} 2002-2003, 2013-2017 Free Software Foundation, Inc. @quotation diff --git a/doc/misc/ido.texi b/doc/misc/ido.texi index 0a56bc3f4e..0b215e8cf0 100644 --- a/doc/misc/ido.texi +++ b/doc/misc/ido.texi @@ -7,7 +7,7 @@ @copying This file documents the Ido package for GNU Emacs. -Copyright @copyright{} 2013-2016 Free Software Foundation, Inc. +Copyright @copyright{} 2013-2017 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document diff --git a/doc/misc/sem-user.texi b/doc/misc/sem-user.texi index fd88c88c7e..4e395f7a11 100644 --- a/doc/misc/sem-user.texi +++ b/doc/misc/sem-user.texi @@ -1,5 +1,5 @@ @c This is part of the Semantic manual. -@c Copyright (C) 1999-2005, 2007, 2009-2016 Free Software Foundation, +@c Copyright (C) 1999-2005, 2007, 2009-2017 Free Software Foundation, @c Inc. @c See file semantic.texi for copying conditions. diff --git a/doc/misc/texinfo.tex b/doc/misc/texinfo.tex index 37e2de896e..922e0015d7 100644 --- a/doc/misc/texinfo.tex +++ b/doc/misc/texinfo.tex @@ -5,10 +5,7 @@ % \def\texinfoversion{2016-04-14.07} % -% Copyright 1985, 1986, 1988, 1990, 1991, 1992, 1993, 1994, 1995, -% 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, -% 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016 -% Free Software Foundation, Inc. +% Copyright 1985-1986, 1988, 1990-2017 Free Software Foundation, Inc. % % This texinfo.tex file is free software: you can redistribute it and/or % modify it under the terms of the GNU General Public License as diff --git a/doc/misc/todo-mode.texi b/doc/misc/todo-mode.texi index d68af9a23a..0bdb37cd0f 100644 --- a/doc/misc/todo-mode.texi +++ b/doc/misc/todo-mode.texi @@ -9,7 +9,7 @@ @c %**end of header @copying -Copyright @copyright{} 2013-2016 Free Software Foundation, Inc. +Copyright @copyright{} 2013-2017 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document diff --git a/doc/misc/trampver.texi b/doc/misc/trampver.texi index b12614bae5..0a0b6f0b9c 100644 --- a/doc/misc/trampver.texi +++ b/doc/misc/trampver.texi @@ -2,7 +2,7 @@ @c texi/trampver.texi. Generated from trampver.texi.in by configure. @c This is part of the Emacs manual. -@c Copyright (C) 2003-2016 Free Software Foundation, Inc. +@c Copyright (C) 2003-2017 Free Software Foundation, Inc. @c See file doclicense.texi for copying conditions. @c In the Tramp GIT, the version number is auto-frobbed from diff --git a/etc/CALC-NEWS b/etc/CALC-NEWS index 8c116e2c60..844b976734 100644 --- a/etc/CALC-NEWS +++ b/etc/CALC-NEWS @@ -1,4 +1,4 @@ -Copyright (C) 2001-2016 Free Software Foundation, Inc. +Copyright (C) 2001-2017 Free Software Foundation, Inc. See the end of the file for license conditions. Calc is an advanced desk calculator for GNU Emacs. diff --git a/etc/ChangeLog.1 b/etc/ChangeLog.1 index b2694d78a1..e502c6539d 100644 --- a/etc/ChangeLog.1 +++ b/etc/ChangeLog.1 @@ -6891,7 +6891,7 @@ ;; coding: utf-8 ;; End: - Copyright (C) 1993-1999, 2001-2016 Free Software Foundation, Inc. + Copyright (C) 1993-1999, 2001-2017 Free Software Foundation, Inc. This file is part of GNU Emacs. diff --git a/etc/DEBUG b/etc/DEBUG index 8a803e0545..9e3515877e 100644 --- a/etc/DEBUG +++ b/etc/DEBUG @@ -1,6 +1,6 @@ Debugging GNU Emacs -Copyright (C) 1985, 2000-2016 Free Software Foundation, Inc. +Copyright (C) 1985, 2000-2017 Free Software Foundation, Inc. See the end of the file for license conditions. ** Preliminaries diff --git a/etc/DISTRIB b/etc/DISTRIB index 237e7f265f..7e3a3517f1 100644 --- a/etc/DISTRIB +++ b/etc/DISTRIB @@ -1,7 +1,7 @@ -*- text -*- GNU Emacs availability information -Copyright (C) 1986-1993, 1995, 1998, 2000-2016 Free Software Foundation, +Copyright (C) 1986-1993, 1995, 1998, 2000-2017 Free Software Foundation, Inc. See the end of the file for license conditions. diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 69b846884f..b140e44630 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -1,6 +1,6 @@ ERC NEWS -*- outline -*- -Copyright (C) 2006-2016 Free Software Foundation, Inc. +Copyright (C) 2006-2017 Free Software Foundation, Inc. See the end of the file for license conditions. * For changes after ERC 5.3, see the main Emacs NEWS file diff --git a/etc/ETAGS.EBNF b/etc/ETAGS.EBNF index dfbf02bccd..fc20b9f858 100644 --- a/etc/ETAGS.EBNF +++ b/etc/ETAGS.EBNF @@ -94,7 +94,7 @@ those. ===================== end of discussion of tag names ===================== -Copyright (C) 2002-2016 Free Software Foundation, Inc. +Copyright (C) 2002-2017 Free Software Foundation, Inc. COPYING PERMISSIONS: diff --git a/etc/ETAGS.README b/etc/ETAGS.README index c590d329a3..f14a102057 100644 --- a/etc/ETAGS.README +++ b/etc/ETAGS.README @@ -28,7 +28,7 @@ ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -Copyright (C) 1984, 1987-1989, 1993-1995, 1998-2016 Free Software +Copyright (C) 1984, 1987-1989, 1993-1995, 1998-2017 Free Software Foundation, Inc. This file is not considered part of GNU Emacs. diff --git a/etc/GNUS-NEWS b/etc/GNUS-NEWS index 06badc1837..410825dfa3 100644 --- a/etc/GNUS-NEWS +++ b/etc/GNUS-NEWS @@ -1,6 +1,6 @@ GNUS NEWS -- history of user-visible changes. -Copyright (C) 1999-2016 Free Software Foundation, Inc. +Copyright (C) 1999-2017 Free Software Foundation, Inc. See the end of the file for license conditions. Please send Gnus bug reports to bugs@gnus.org. diff --git a/etc/HELLO b/etc/HELLO index 1dc402a55b..f5339f224d 100644 --- a/etc/HELLO +++ b/etc/HELLO @@ -75,7 +75,7 @@ Korean ($(CGQ1[(B) $(C>H3gGO<H3gGO=J4O1n(B -Copyright (C) 2001-2016 Free Software Foundation, Inc. +Copyright (C) 2001-2017 Free Software Foundation, Inc. This file is part of GNU Emacs. diff --git a/etc/MACHINES b/etc/MACHINES index fcab23c7b5..8e820d14c6 100644 --- a/etc/MACHINES +++ b/etc/MACHINES @@ -1,6 +1,6 @@ Emacs machines list -Copyright (C) 1989-1990, 1992-1993, 1998, 2001-2016 Free Software +Copyright (C) 1989-1990, 1992-1993, 1998, 2001-2017 Free Software Foundation, Inc. See the end of the file for license conditions. diff --git a/etc/MH-E-NEWS b/etc/MH-E-NEWS index efdcaf2d63..7e852afb71 100644 --- a/etc/MH-E-NEWS +++ b/etc/MH-E-NEWS @@ -1,6 +1,6 @@ * COPYRIGHT -Copyright (C) 2001-2016 Free Software Foundation, Inc. +Copyright (C) 2001-2017 Free Software Foundation, Inc. See the end of the file for license conditions. * Changes in MH-E 8.6 diff --git a/etc/NEWS b/etc/NEWS index 38975a7fa1..58ac617a79 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1,6 +1,6 @@ GNU Emacs NEWS -- history of user-visible changes. -Copyright (C) 2014-2016 Free Software Foundation, Inc. +Copyright (C) 2014-2017 Free Software Foundation, Inc. See the end of the file for license conditions. Please send Emacs bug reports to bug-gnu-emacs@gnu.org. diff --git a/etc/NEWS.1-17 b/etc/NEWS.1-17 index 4eacd6ddc6..0a7ca052d7 100644 --- a/etc/NEWS.1-17 +++ b/etc/NEWS.1-17 @@ -1,6 +1,6 @@ GNU Emacs NEWS -- history of user-visible changes. 26-Mar-1986 -Copyright (C) 1985-1986, 2006-2016 Free Software Foundation, Inc. +Copyright (C) 1985-1986, 2006-2017 Free Software Foundation, Inc. See the end of the file for license conditions. diff --git a/etc/NEWS.18 b/etc/NEWS.18 index ab1ded8dcf..93e07df806 100644 --- a/etc/NEWS.18 +++ b/etc/NEWS.18 @@ -1,6 +1,6 @@ GNU Emacs NEWS -- history of user-visible changes. 17-Aug-1988 -Copyright (C) 1988, 2006-2016 Free Software Foundation, Inc. +Copyright (C) 1988, 2006-2017 Free Software Foundation, Inc. See the end of the file for license conditions. diff --git a/etc/NEWS.19 b/etc/NEWS.19 index 3f3b5870db..70f8673534 100644 --- a/etc/NEWS.19 +++ b/etc/NEWS.19 @@ -1,6 +1,6 @@ GNU Emacs NEWS -- history of user-visible changes. 1992. -Copyright (C) 1993-1995, 2001, 2006-2016 Free Software Foundation, Inc. +Copyright (C) 1993-1995, 2001, 2006-2017 Free Software Foundation, Inc. See the end of the file for license conditions. diff --git a/etc/NEWS.20 b/etc/NEWS.20 index e5cca54a64..3e829d1a16 100644 --- a/etc/NEWS.20 +++ b/etc/NEWS.20 @@ -1,6 +1,6 @@ GNU Emacs NEWS -- history of user-visible changes. 2006-05-31 -Copyright (C) 1999-2001, 2006-2016 Free Software Foundation, Inc. +Copyright (C) 1999-2001, 2006-2017 Free Software Foundation, Inc. See the end of the file for license conditions. diff --git a/etc/NEWS.21 b/etc/NEWS.21 index 7dfdc4dfdd..4a214cb3d2 100644 --- a/etc/NEWS.21 +++ b/etc/NEWS.21 @@ -1,6 +1,6 @@ GNU Emacs NEWS -- history of user-visible changes. 2006-05-31 -Copyright (C) 2000-2016 Free Software Foundation, Inc. +Copyright (C) 2000-2017 Free Software Foundation, Inc. See the end of the file for license conditions. diff --git a/etc/NEWS.22 b/etc/NEWS.22 index 5e414f18d6..689eff9c85 100644 --- a/etc/NEWS.22 +++ b/etc/NEWS.22 @@ -1,6 +1,6 @@ GNU Emacs NEWS -- history of user-visible changes. -Copyright (C) 2001-2016 Free Software Foundation, Inc. +Copyright (C) 2001-2017 Free Software Foundation, Inc. See the end of the file for license conditions. Please send Emacs bug reports to bug-gnu-emacs@gnu.org. diff --git a/etc/NEWS.23 b/etc/NEWS.23 index f74141db49..78802d288d 100644 --- a/etc/NEWS.23 +++ b/etc/NEWS.23 @@ -1,6 +1,6 @@ GNU Emacs NEWS -- history of user-visible changes. -Copyright (C) 2007-2016 Free Software Foundation, Inc. +Copyright (C) 2007-2017 Free Software Foundation, Inc. See the end of the file for license conditions. Please send Emacs bug reports to bug-gnu-emacs@gnu.org. diff --git a/etc/NEWS.24 b/etc/NEWS.24 index 08021f4ee0..fc52ffffd6 100644 --- a/etc/NEWS.24 +++ b/etc/NEWS.24 @@ -1,6 +1,6 @@ GNU Emacs NEWS -- history of user-visible changes. -Copyright (C) 2010-2016 Free Software Foundation, Inc. +Copyright (C) 2010-2017 Free Software Foundation, Inc. See the end of the file for license conditions. Please send Emacs bug reports to bug-gnu-emacs@gnu.org. diff --git a/etc/NEXTSTEP b/etc/NEXTSTEP index 60c49ad8c7..d3e4828f89 100644 --- a/etc/NEXTSTEP +++ b/etc/NEXTSTEP @@ -1,4 +1,4 @@ -Copyright (C) 2008-2016 Free Software Foundation, Inc. +Copyright (C) 2008-2017 Free Software Foundation, Inc. See the end of the file for license conditions. This file contains information about GNU Emacs on "Nextstep" platforms. diff --git a/etc/NXML-NEWS b/etc/NXML-NEWS index 9197777126..edf7c13742 100644 --- a/etc/NXML-NEWS +++ b/etc/NXML-NEWS @@ -1,4 +1,4 @@ -Copyright (C) 2007-2016 Free Software Foundation, Inc. +Copyright (C) 2007-2017 Free Software Foundation, Inc. See the end of the file for license conditions. diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS index 8d8c0c604a..38df7b2bd8 100644 --- a/etc/ORG-NEWS +++ b/etc/ORG-NEWS @@ -3,7 +3,7 @@ ORG NEWS -- history of user-visible changes. -*- mode: org; coding: utf-8 -*- #+LINK: doc http://orgmode.org/worg/doc.html#%s #+LINK: git http://orgmode.org/w/?p=org-mode.git;a=commit;h=%s -Copyright (C) 2012-2016 Free Software Foundation, Inc. +Copyright (C) 2012-2017 Free Software Foundation, Inc. See the end of the file for license conditions. Please send Org bug reports to emacs-orgmode@gnu.org. diff --git a/etc/PROBLEMS b/etc/PROBLEMS index 9904339be4..be15afaa7c 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS @@ -1,6 +1,6 @@ Known Problems with GNU Emacs -Copyright (C) 1987-1989, 1993-1999, 2001-2016 Free Software Foundation, +Copyright (C) 1987-1989, 1993-1999, 2001-2017 Free Software Foundation, Inc. See the end of the file for license conditions. diff --git a/etc/README b/etc/README index e7758fdb90..23e1f9fdab 100644 --- a/etc/README +++ b/etc/README @@ -7,5 +7,5 @@ COPYRIGHT AND LICENSE INFORMATION FOR IMAGE FILES File: emacs.icon Author: Sun Microsystems, Inc - Copyright (C) 1999, 2001-2016 Free Software Foundation, Inc. + Copyright (C) 1999, 2001-2017 Free Software Foundation, Inc. License: GNU General Public License version 3 or later (see COPYING) diff --git a/etc/TERMS b/etc/TERMS index 99d6c46ad2..52379724c7 100644 --- a/etc/TERMS +++ b/etc/TERMS @@ -1,4 +1,4 @@ -Copyright (C) 1999, 2001-2016 Free Software Foundation, Inc. +Copyright (C) 1999, 2001-2017 Free Software Foundation, Inc. See the end of the file for copying permissions. This file describes what you must or might want to do to termcap entries diff --git a/etc/TODO b/etc/TODO index 84c1b6d8ff..fc442f9307 100644 --- a/etc/TODO +++ b/etc/TODO @@ -1,6 +1,6 @@ Emacs TODO List -*-outline-*- -Copyright (C) 2001-2016 Free Software Foundation, Inc. +Copyright (C) 2001-2017 Free Software Foundation, Inc. See the end of the file for license conditions. diff --git a/etc/charsets/README b/etc/charsets/README index b159ffef80..315c364345 100644 --- a/etc/charsets/README +++ b/etc/charsets/README @@ -1,6 +1,6 @@ # README file for charset mapping files in this directory. -# Copyright (C) 2003-2016 Free Software Foundation, Inc. +# Copyright (C) 2003-2017 Free Software Foundation, Inc. # Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 # National Institute of Advanced Industrial Science and Technology (AIST) # Registration Number H13PRO009 diff --git a/etc/compilation.txt b/etc/compilation.txt index d26af20985..3a71c6da8f 100644 --- a/etc/compilation.txt +++ b/etc/compilation.txt @@ -599,7 +599,7 @@ Compilation segmentation fault at Thu Jul 13 10:55:49 Compilation finished at Thu Jul 21 15:02:15 -Copyright (C) 2004-2016 Free Software Foundation, Inc. +Copyright (C) 2004-2017 Free Software Foundation, Inc. COPYING PERMISSIONS: diff --git a/etc/edt-user.el b/etc/edt-user.el index cf1acbcdb1..80f3b7e578 100644 --- a/etc/edt-user.el +++ b/etc/edt-user.el @@ -1,6 +1,6 @@ ;;; edt-user.el --- Sample user customizations for Emacs EDT emulation -;; Copyright (C) 1986, 1992-1993, 2000-2016 Free Software Foundation, +;; Copyright (C) 1986, 1992-1993, 2000-2017 Free Software Foundation, ;; Inc. ;; Author: Kevin Gallagher diff --git a/etc/emacs-buffer.gdb b/etc/emacs-buffer.gdb index d51e7ad8a8..db58eeb8e9 100644 --- a/etc/emacs-buffer.gdb +++ b/etc/emacs-buffer.gdb @@ -1,6 +1,6 @@ # emacs-buffer.gdb --- gdb macros for recovering buffers from emacs coredumps -# Copyright (C) 2005-2016 Free Software Foundation, Inc. +# Copyright (C) 2005-2017 Free Software Foundation, Inc. # Maintainer: Noah Friedman # Created: 2005-04-28 diff --git a/etc/emacs.appdata.xml b/etc/emacs.appdata.xml index 05c5e2a1b2..0ba305c452 100644 --- a/etc/emacs.appdata.xml +++ b/etc/emacs.appdata.xml @@ -1,5 +1,5 @@ - + emacs.desktop GFDL-1.3 diff --git a/etc/enriched.txt b/etc/enriched.txt index 253f3dd074..e1f2d6cc15 100644 --- a/etc/enriched.txt +++ b/etc/enriched.txt @@ -239,7 +239,7 @@ it. -Copyright (C) 1995, 1997, 2001-2016 Free Software Foundation, Inc. +Copyright (C) 1995, 1997, 2001-2017 Free Software Foundation, Inc. COPYING PERMISSIONS: diff --git a/etc/forms/forms-d2.el b/etc/forms/forms-d2.el index d219532971..edd1a2dd59 100644 --- a/etc/forms/forms-d2.el +++ b/etc/forms/forms-d2.el @@ -1,6 +1,6 @@ ;;; forms-d2.el --- demo forms-mode -;; Copyright (C) 1991, 1994-1997, 2001-2016 Free Software Foundation, +;; Copyright (C) 1991, 1994-1997, 2001-2017 Free Software Foundation, ;; Inc. ;; Author: Johan Vromans diff --git a/etc/gnus-tut.txt b/etc/gnus-tut.txt index 530b27bb29..74b110f479 100644 --- a/etc/gnus-tut.txt +++ b/etc/gnus-tut.txt @@ -24,7 +24,7 @@ was done by moi, yours truly, your humble servant, Lars Magne Ingebrigtsen. If you have a WWW browser, you can investigate to your heart's delight at . -;; Copyright (C) 1995, 2001-2016 Free Software Foundation, Inc. +;; Copyright (C) 1995, 2001-2017 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news diff --git a/etc/grep.txt b/etc/grep.txt index 3861a7f044..582bc5fd01 100644 --- a/etc/grep.txt +++ b/etc/grep.txt @@ -97,7 +97,7 @@ grep -nH -e "xyzxyz" ../info/* -Copyright (C) 2005-2016 Free Software Foundation, Inc. +Copyright (C) 2005-2017 Free Software Foundation, Inc. COPYING PERMISSIONS: diff --git a/etc/images/README b/etc/images/README index 47c797c6f1..7c48091c22 100644 --- a/etc/images/README +++ b/etc/images/README @@ -27,7 +27,7 @@ COPYRIGHT AND LICENSE INFORMATION FOR IMAGE FILES File: mh-logo.xpm Author: Satyaki Das - Copyright (C) 2003-2016 Free Software Foundation, Inc. + Copyright (C) 2003-2017 Free Software Foundation, Inc. Files: gnus.pbm Author: Luis Fernandes diff --git a/etc/images/custom/README b/etc/images/custom/README index c90c555cbd..a8e410298f 100644 --- a/etc/images/custom/README +++ b/etc/images/custom/README @@ -6,5 +6,5 @@ COPYRIGHT AND LICENSE INFORMATION FOR IMAGE FILES Files: down.xpm down-pushed.xpm right.xpm right-pushed.xpm Author: Juri Linkov -Copyright (C) 2008-2016 Free Software Foundation, Inc. +Copyright (C) 2008-2017 Free Software Foundation, Inc. License: GNU General Public License version 3 or later (see COPYING) diff --git a/etc/images/ezimage/README b/etc/images/ezimage/README index 20c2cca549..c16635508e 100644 --- a/etc/images/ezimage/README +++ b/etc/images/ezimage/README @@ -7,5 +7,5 @@ Files: bits.xpm bitsbang.xpm box-minus.xpm box-plus.xpm tag-gt.xpm tag-minus.xpm tag-plus.xpm tag-type.xpm tag-v.xpm tag.xpm unlock.xpm Author: Eric M. Ludlam -Copyright (C) 1999-2016 Free Software Foundation, Inc. +Copyright (C) 1999-2017 Free Software Foundation, Inc. License: GNU General Public License version 3 or later (see COPYING) diff --git a/etc/images/gnus/README b/etc/images/gnus/README index ee9d96419f..0523215909 100644 --- a/etc/images/gnus/README +++ b/etc/images/gnus/README @@ -7,7 +7,7 @@ COPYRIGHT AND LICENSE INFORMATION FOR IMAGE FILES Files: important.xpm, unimportant.xpm Author: Simon Josefsson -Copyright (C) 2001-2016 Free Software Foundation, Inc. +Copyright (C) 2001-2017 Free Software Foundation, Inc. Files: catchup.pbm catchup.xpm cu-exit.pbm cu-exit.xpm describe-group.pbm describe-group.xpm exit-gnus.pbm exit-gnus.xpm diff --git a/etc/images/gnus/gnus.svg b/etc/images/gnus/gnus.svg index 720dcbb1c8..0d9d863b11 100644 --- a/etc/images/gnus/gnus.svg +++ b/etc/images/gnus/gnus.svg @@ -1,7 +1,7 @@